DPYSER page# 0001 next
2: COMMENT ⊗   VALID 00125 PAGES
3: C REC  PAGE   DESCRIPTION
4: C00001 00001
5: C00014 00002    SUBTTL III DISPLAY PACKAGE - D. POOLE - NOV 1968
6: C00016 00003     BYTE POINTERS INTO BITS THAT SAY SIZE SET BY USER OR UUO
7: C00018 00004    COMMENT   THE FOLLOWING IS SYSTEM START TIME INITIALIZING CODE.
8: C00021 00005     THIS ROUTINE MAKES UP A PROGRAM HEADER AND LINE EDITOR BUFFER.
9: C00026 00006     MORE INITIALIZE CODE FOR A NEW PROGRAM-LINED-BUFFER THING
10: C00028 00007     NOW SET UP THE POINTERS IN THE TABLES TO GET THE DP STARTED
11: C00031 00008    GETTING NEW DATA DISC CHANNEL. FIRST DESELECT AVAILABLE MSG,
12: C00033 00009     ENTER HERE AT CLOCK LEVEL WITH LINE NUMBER IN TAC TO
13: C00036 00010            PUSHJ P,DPYKFS          GIVE ALL THE CORE BACK
14: C00039 00011     WE GET HERE TO PLANT ANOTHER CLOCK REQUEST TO COME BACK
15: C00041 00012     HERE ARE THE INTERRUPT ROUTINES FOR RUNNING THE DP.
16: C00044 00013    HERE WE HAVE AND ERROR - - PRINT A MESSAGE AND CHECK THE SYSTEM!
17: C00047 00014     DP INTERRUPT CODE - RESTART PROGRAM, LOOP AROUND OF NEXT DPY, STOP DP, SET AVAILABLE MESSAGE
18: C00049 00015    PPINIT          PAGE PRINTER STUFF
19: C00052 00016            SETZM PPDD(DAT)          ASSUME III UNTIL PROVEN OTHERWISE
20: C00055 00017     FREE STORAGE HANDLER FOR PAGE PRINTER
21: C00057 00018    BELOW IS THE PROTOTYPICAL P. OF P. CONTROL BLOCK.
22: C00062 00019    TYO, DPYTYO.
23: C00067 00020     WE GET HERE IF THE LAST CHARACTER WAS A LF AND WE ARE AT THE LEFT MARGIN
24: C00071 00021    PR1ECR: JUMPGE DAT,PR1EC1        IS THIS A DD?
25: C00075 00022    BEGIN EXTBUF    MAKE MORE ROOM IN THE DISPLAY BUFFER.
26: C00079 00023     WE GET HERE UPON GLITCHING ON A DATA DISC DISPLAY
27: C00082 00024     THESE ARE UTILITY ROUTINES USED BY THE PAGE PRINTER
28: C00085 00025     HANDY ROUTINE TO GET POINTER TO TEXT FROM LINE NUMBER IN AC3
29: C00086 00026     WE GET HERE IF THE POINTERS DON'T AGREE
30: C00087 00027     ROUTINE TO CONVERT THE POSITION VECTOR INTO A DATA DISK
31: C00088 00028    FBLK:   PUSH P,AC1              FREE SOME BLOCKS FROM P.P.
32: C00091 00029    PPOUT:  WE GET HERE WHEN IT IS TIME TO OUTPUT PART OF A PIECE OF PAPER TO THE DISK.
33: C00093 00030    A SIMPLE MESSAGE PRINTER. JSA ITEM,ERRP WITH
34: C00094 00031    HERE ARE UUO LEVEL ROUTINES FOR MANIPULATING THE PAGE PRINTER.
35: C00097 00032    MORE PP ROUTINES.
36: C00101 00033    PPSEL <N>  MAKES P. OF P. <N> THE CURRENT ONE AND TURNS IT ON.
37: C00104 00034     ROUTINE TO WAIT FOR TYPEOUT TO FINISH
38: C00105 00035    PPYPOS Y MAKES THE CURRENT P OF P START AT Y COORD. Y.
39: C00108 00036     WE GET HERE WHEN THE APPEARANCE OF THE PAGE HAS CHANGED ENOUGH
40: C00110 00037     ROUTINE TO ERASE PARTS OF DATA DISK SCREEN
41: C00112 00038     HERE IS A ROUTINE TO MOVE THE LINE POINTER TABLE AROUND
42: C00114 00039    PPXSIZ <N>B26 ! <M>  SETS CURRENT P OF P TO HAVE N GLITCHES OF M LINES.
43: C00117 00040    CLKSER  THIS IS DPYSER'S OWN PRIVATE CLOCK QUEUER.
44: C00120 00041     THIS ROUTINE QUEUES UP ANOTHER WHO LINE REQUEST.
45: C00123 00042     ROUTINE TO FREE AN ENTIRE LIST OF BLOCKS, LINKED UP THROUGH LINK
46: C00125 00043    UUO LEVEL UTILITY ROUTINES AND DISPATCHERS.
47: C00128 00044    MORE GENERAL UUO ROUTINES.
48: C00129 00045     ROUTINE TO RESET A DISPLAY. CLEARS PAGE PRINTER AND PIECES OF GLASS.
49: C00132 00046     CALLED FROM <ESC>N IN LINE EDITOR BY A CLOCK REQUEST
50: C00134 00047     CALLED FROM <ESC>L IN LINE EDITOR. SETS LINES/GLITCH
51: C00136 00048     SET PAGE PRINTER HOLD COUNTS. GIVE LINE COUNT IN BITS 18-26 AND
52: C00138 00049     THIS ROUTINE GIVES THE USER A NICE LITTLE TABLE OF DATA ABOUT HIS
53: C00142 00050     PPINFO CONT - RUN DOWN LIST OF PP CTRL BLOCKS
54: C00144 00051     THIS IS THE ROUTINE FOR A UUO WHICH SETS YOUR LINE EDITOR'S VERTICAL
55: C00146 00052    FREEL FREES A LIST OF BLOCKS POINTED TO BY AC1, AND UPDATES
56: C00147 00053    UPG IS THE DEMOCRATIC UUO WHICH ALLOWS ALL MEN,
57: C00150 00054            MOVN TAC1,UCHN          LENGTH OF USERS CODE.
58: C00153 00055    MORE OF UPG.
59: C00155 00056     RST WITH NO PARAM BITS ON IS A NOOP -- ALLOW ANY ARGUMENT
60: C00157 00057     DATA DISC PROGRAM HANDLER
61: C00161 00058     HERE WE ARE, READY TO SET THE CHANNEL ADDRESS OF HIS DATA DISC PROGRAM
62: C00164 00059     GET HERE TO LOOK AT A USER'S COMMAND WORD AND SEE IF THERE IS A CHANNEL SELECT
63: C00166 00060    CHANNEL ADDRESS CHECKING. HE CAN WRITE ON HIS OWN SCREEN,
64: C00168 00061    PGSET  SETS UP REQUESTED PIECE OF GLASS.
65: C00170 00062     THIS IS THE DPY ERROR ROUTINE. IT TYPES OUT THE PC IN TAC1 ON
66: C00172 00063    ↑↑UPGMVM:PUSHJ P,UPGMV          DO `MOVEM' INTO P OF G: TAKE CARE OF PRELIMINARIES.
67: C00175 00064    ↑↑PGIOT:
68: C00178 00065     THIS UUO GETS INFORMATION FROM THE SYSTEM ABOUT THE USER'S PIECES
69: C00180 00066    DPYTYP IS CALLED AT CLOCK LEVEL TO TYPE SOME CHRS. FROM A 
70: C00183 00067     HERE WE ARE AT CLOCK LEVEL WITH (SUPPOSEDLY) DAT SET TO
71: C00187 00068     ROUTINE TO TYPE CTY ERROR MESSAGE ON ILLEGAL LINE NUMBER
72: C00189 00069     ROUTINE, CALLED FROM CLOCK CALL WITH LINE NUMBER IN DAT, TO CONTINUE PAGE PRINTER
73: C00192 00070     COME HERE FOR DATA DISK TO SEE IF IT IS END OF LINE OR GLITCH TIME.
74: C00193 00071    SUBTTL DATA DISK SERVICE ROUTINE - JAM, DEC. 1970
75: C00196 00072     CLOCK LEVEL QUEING SCHEME. PLANTS TASKS IN QUEUE AND LEAVES.
76: C00200 00073     WE GET HERE AT CLOCK LEVEL IN THE MIDDLE OF QUEUEING UP A WHOLE SCREEN REQUEST.
77: C00203 00074     WE GET HERE TO QUEUE UP A ONE LINE REQUEST.
78: C00206 00075     THIS ROUTINE QUEUES UP AN ERASURE REQUEST FOR THE LINE EDITOR <ESC>C COMMAND
79: C00209 00076     HERE LIES A ROUTINE TO QUEUE UP A WHOLE PAGE TRANSFER WHEN NOT GLITCHING
80: C00212 00077     HERE IS THE MIGHTY LINE EDITOR AND CURSOR GENERATOR.
81: C00214 00078     HERE WE SET UP THE CURSOR POSITION AND START ON THE DECISION TREE
82: C00217 00079     WE GET HERE IF THE VERTICAL POSITION OF THE LINE EDITOR HAS NOT CHANGED.
83: C00220 00080     LINE EDITOR DECISION TREE. WE GET HERE IF THE LINE EDITOR CURSOR HAS NOT
84: C00223 00081     EVERYBODY COMES HERE TO EXIT
85: C00225 00082     THIS ROUTINE QUEUES UP A LINE EDITOR TEXT REQUEST
86: C00227 00083     THIS ROUTINE ERASES THE OLD SECOND LINE OF THE LINE EDITOR
87: C00229 00084     THIS ROUTINE ERASES THE OLD CURSOR
88: C00231 00085     THESE ROUTINES QUEUE UP THE VARIOUS COMBINATIONS OF CURSORS THAT MAY ARISE.
89: C00233 00086    QBLOCK    HERE IS THE MAGIC SCHEDULING QUEUE ROUTINE
90: C00236 00087     HERE WE SEE IF THE TASK IS AN EASY OUTSIDER.
91: C00239 00088     HERE WE SCAN THE QUEUE SYSTEM LOOKING FOR A FRAME WITH SOME FREE LINES
92: C00242 00089     WE GET HERE IF THE TASK IS ENTIRELY OUT OF BOUNDS
93: C00244 00090     WE GET HERE WHEN THERE IS NO QUEUE AT ALL.
94: C00246 00091     HERE IS A ROUTINE THAT MOVES ON TO THE NEXT FRAME, IF THERE IS NO NEXT
95: C00252 00092     HERE LIES THE INCREDIBLE INTERRUPT-LEVEL ROUTINES!
96: C00254 00093     ALL THE I-LEVEL ROUTINES RETURN TO HERE WHEN THEY ARE DONE
97: C00256 00094     THIS ROUTINE IS CALLED AT CLOCK LEVEL WITH A LIST OF TASKS THAT
98: C00257 00095     THIS ROUTINE TAKES A TASK OUT OF THE QUEUE AND WAKES UP ANYONE IF
99: C00260 00096     PAGE PRINTER TRANSFERS
100: C00264 00097    PPXFR3: MOVEI AC1,DDCW(DAT)      PICK UP ADDRESS OF START OF TRANSFER
101: C00266 00098     HERE IS THE ERASE CODE.
102: C00268 00099     CURSOR TRANSFERS.
103: C00271 00100     THIS ROUTINE MAKES UP THE CODE FOR A CURSOR.
104: C00273 00101     LINE EDITOR TRANSFERS
105: C00276 00102     WE GET HERE WHEN THE TRANSFER IS DONE OR ABORTED.
106: C00278 00103     WHOLE SCREEN ERASURE AND AVAILABLE MESSAGE
107: C00281 00104     USER DATA DISC PROGRAM . . .
108: C00284 00105     ALL TRANSFERS COME BACK TO HERE WHEN THEY ARE DONE OR TIMED OUT
109: C00286 00106     DATA DISC NON-EX MEM TYPEOUT, ACCUMULATOR SAVER, AND CLOCK TIMEOUT ROUTINES
110: C00288 00107     WE GET HERE IF WE GET AN INTERRUPT FROM THE DATA DISK AND
111: C00289 00108    DEFINITIONS FOR DATA DISC ALLOCATION
112: C00291 00109    INITIALIZATION FOR DATA DISC ALLOCATION AND VIDEO SWITCH
113: C00294 00110    ALL-PURPOSE DD CHANNEL DIDDLING UUO:
114: C00296 00111    RELEASE CHANNEL C(TAC)
115: C00298 00112    GET CHAN SPECIFIED BY TAC(31-35) IF FREE
116: C00300 00113    ROUTINE TO THROW ALL SPIES OFF PRIVATE CHANNEL.
117: C00303 00114    SET STATUS OF CONSOLE CHANNEL
118: C00306 00115    ALL-PURPOSE VDS DIDDLING UUO:
119: C00309 00116    VDMAP2: HLL TAC,VDDSP(AC1)
120: C00311 00117    VDSET:  PUSHJ P,VDWCHK
121: C00313 00118    ROUTINE TO BLESS BITS ABOUT TO BE TURNED ON FOR PRIVACY VIOLATION
122: C00315 00119    SUBTTL WHO LINE GENERATOR--R. HELLIWELL--6/APR/70
123: C00318 00120    ↑WHOSER:MOVE    DAT,TIME
124: C00323 00121    WHOSIX: MOVEI   AC2,6                   CHARACTER COUNT
125: C00326 00122    THIS IS THE PART WE ALWAYS UPDATE.
126: C00331 00123     THIS ROUTINE SETS UP A NEW WHO TABLE FROM A PIECE OF FREE STORAGE
127: C00334 00124    WLRET:  MOVE    AC3,[POINT 7,WTEND+5(AC1),20]
128: C00339 00125    ↑WHOSYS:
129: C00346 ENDMK
130: C⊗;
    DPYSER page# 0002 next  prev
132: SUBTTL III DISPLAY PACKAGE - D. POOLE - NOV 1968
133: COMMENT ⊗
134:         THESE ARE THE GLORIOUS, WORLD-SAVING III DISPLAY
135: ROUTINES.  FOR THEIR FIRST TRICK, THEY WILL IMPERSONATE
136: W. F. WEIHER, THUS STARTING THE PROGRAM ON A NOTE OF
137: LIGHT HUMOR.
138: 
139: ⊗
140: 
141: BEGIN DPYSER
142: 
143: ↓CHR←TEM        ;SAME AS CHREC IN SCNSER
144: 
145: ;; NOW SOME DISPLAY OPCODES AND MACROS FOR GENERATING DP INSTRS.
146: 
147: DISJMP←←20      ;DP JMP INSTR. OPCODE.
148: DISJMS←←4       ; JMS (STORES TWO WORDS)
149: DISJSR←←24      ; STORES ONLY RETURN ADDR.
150: DISRST←←14      ;RESTORE.
151: DISSEL←←10      ;SELECT.
152: DISNOP←←14      ;ACTUALLY RST, BUT A GOOD NOP WITH ALL BITS OFF.
153: 
154: DEFINE LVW(X,Y,TYPE,MODE,BRT,SIZ)       ;ASSEMBLES A LONG VECTOR.
155:   { MVW1 (MODE,TYPE,BRT,SIZ)    ;TWIDDLE PARAMS.
156:         BYTE (11)<X>,<Y>(3)B,S(2)MD,TT(3)3 }    ;ASSEMBLE INSTR.
157: DEFINE MVW1 (M,T,BRT,SIZ)
158:  {IFIDN {M}{A}{MD←1;}MD←0       ;MODE = `A' FOR ABSOLUTE.
159:   IFIDN {T}{I}{TT←2;}TT←0       ;TYPE = `I' FOR INVISIBLE.
160:   IFIDN {BRT}{}{B←0;}B←BRT      ;BRT = 0 IF OMITTED.
161:   IFIDN {SIZ}{}{S←0;}S←SIZ      ;SAME FOR SIZ.
162: }
163: DEFINE ERMS (X) {JSA ITEM,ERRP
164: POINT 7,[ASCIZ ⊗X
165: ⊗]
166: }
167: DEFINE CW (C1,B1,C2,B2,C3,B3) {<BYTE (8)<B1>,<B2>,<B3>(3)<C1>,<C2>,<C3>>!4}
168: GLOBAL DDTAB,JB2SWP     ;STUPID FAIL
    DPYSER page# 0003 next  prev
170: ; BYTE POINTERS INTO BITS THAT SAY SIZE SET BY USER OR UUO
171: 
172: SIZSBU: POINT 1,GWORD(DDB),0    ; IF 1, SAYS LINES/GLITCH OR GLITCHES/PAGE SET BY USER LAST
173: POSSBU: POINT 1,GWORD(DDB),1    ; SAYS Y-POS. SET BY USER COMMAND (RATHER THAN UUO)
174: LHCSBU: POINT 1,GWORD(DDB),2    ; SAME FOR LINE HOLD COUNT
175: GHCSBU: POINT 1,GWORD(DDB),3    ; SAME FOR GLITCH HOLD COUNT
176: HLINES: POINT 9,GWORD(DDB),17   ; POINTS TO NUMBER OF LINES BEFORE HOLDING
177: HGLTCH: POINT 9,GWORD(DDB),26   ; POINTS TO NUMBER OF GLITCHES BEFORE HOLDING
178: ;       POINT 9,GWORD(DDB),35   ; CHAR WHICH ACTIVATED LINED
179: 
180: ; NORMAL VALUES FOR THE PAGE PRINTER
181: 
182: NGSIII←←14              ; GLITCHES/PAGE FOR III DISPLAYS
183: NGSDD←←4                ; GLITCHES/PAGE FOR DD DISPLAYS
184: NLSIII←←2               ; LINES/GLITCH FOR III
185: NLSDD←←11               ; LINES/GLITCH FOR DD
186: YPIII←←600              ; Y-POSITION FOR III
187: YPDD←←660               ; Y-POSITION FOR DD
188: ↑NDDSPQ←←60             ;# SPARE DD QUEUE BLOCKS (TIRED OF BEING SCREWED -REG)
189: 
    DPYSER page# 0004 next  prev
191: COMMENT ⊗  THE FOLLOWING IS SYSTEM START TIME INITIALIZING CODE.
192:         MUCH OF IT IS IN TEMPORARY FORM.
193: ⊗
194: 
195: ↑DWPINI:  
196:         MOVEI   AC1,2           ;INITIALIZE COMMON DD CURSOR BUFFER
197:         MOVEM   AC1,DDCURS+2    ;BY PROPAGATING A ZERO GRAPHICS WORD DOWN IT
198:         MOVE    AC1,[XWD DDCURS+2,DDCURS+3]
199:         BLT     AC1,DDCURS+21   ;ALL THE WAY (TOO BAD THAT SOME PEOPLE CAN'T COUNT)
200:         MOVEI TAC,DPYNUM
201:         MOVEM TAC,DRUNCT        ;INIT. PTR. TO NEXT DPY TO RUN.
202:         HRLOI TAC,377777
203:         MOVEM TAC,DDCNT
204:         SETZM FSWTHD            ;CLEAR FS WAIT LIST.
205:         SETZM FSWT2H            ;AND THE WAIT LIST WAIT LIST.
206:         SETZM DDSTART           ; CLEAR ALL THE DATA DISK FLAGS
207:         SETZM DDRUN
208:         SETZM STRTBL            ; ZERO OUT ALL THE IMPORTANT TABLES
209:         MOVE TAC,[XWD STRTBL,STRTBL+1]
210:         BLT TAC,LETAB+DPYNUM+DDNUM-1
211:         SETOM DXFLAG            ;START DP ON FIRST CLOCK TICK.
212:         MOVE TAC,[POINT 36,CLKQUE-1,35]
213:         MOVEM TAC,CLKQ          ;INIT. CLOCK QUEUE PTR.
214:         MOVE TAC,[IOWD LCPDL,CLKPD]     ;..ALSO CLOCK PDL.
215:         MOVEM TAC,DPYPDL
216:         MOVSI TAC,770000        ; RESTORE AVAILABLE MESSAGES
217:         HLLM TAC,DPYAVL+1
218:         HLLM TAC,WHOSEL         ; SYSTEM WHO LINE FOR ALL AVAILABLE IIIS
219:         MOVSI TAC,77            ; DESELECT EVERYONE
220:         HLLM TAC,DPYHLD         ; HOLDING MESSAGE TOO
221: IFN FTOIKB, < CONO KBD,SCNCHN >         ;GIVE INTERRUPT CHANNEL TO KEYBOARD SCANNER.
222:         CONO DDD,10
223:         PUSHJ P,DDINI
224:         JRST WHOINI
225: 
226: DWPERR: PUSHJ P,DISMES
227:         ASCIZ /CATASTROPHIC ERROR FROM DPYSER
228: /
229: DPYATL: SETOM DISFLAG
230:         PUSHJ P,DISFLUSH
231:         JRST AUTOLOAD
    DPYSER page# 0005 next  prev
233: ; THIS ROUTINE MAKES UP A PROGRAM HEADER AND LINE EDITOR BUFFER.
234: ; IT EXPECTS THE LINE NUMBER IN TAC1. PRESERVES ALL OTHER ACCUMULATORS.
235: ; SKIPS UPON SUCCESS. IF FAILURE, WILL PLANT A CLOCK REQUEST AND
236: ; TRY TO GET ONE LATER.
237: 
238: ↑DPYMAKE:
239:         SKIPE LETAB-DPYL0(TAC1) ; DO WE ALREADY HAVE A PROGRAM HEADER?
240:         JRST CPOPJ1             ; YES, GIVE SUCCESS RETURN
241:         PUSH P,TAC
242:         PUSH P,DAT
243:         PUSH P,DDB
244:         PUSH P,AC1
245:         PUSH P,AC2
246:         PUSH P,AC3
247:         MOVNI TAC,1
248:         HLL TAC1,LINTAB(TAC1)
249:         TLNN TAC1,DDDLIN
250:         JRST DPYM1
251:         MOVSI TAC,400100-DDL0(TAC1)
252:         PUSHJ P,DDAGET  ;FIRST MAKE SURE WE HAVE A CHANNEL FOR DD
253:         JRST DPYXTL     ;GO DIRECTLY TO JAIL
254:         ANDI TAC,-1
255: DPYM1:  MOVEI AC3,DHFS
256:         PUSHJ P,SFSGET
257:         JRST DPYM8
258:         HRRZ DDB,AC1
259:         SETZM (AC1)             ; FIRST, ZERO THE THING OUT
260:         HRLZ AC2,AC1
261:         HRRI AC2,1(AC1)
262:         MOVE AC3,AC1
263:         BLT AC2,DPYLEN-1(AC3)
264:         MOVEI AC2,DISRST!60     ; NOW SET UP THE STARTUP WORD TO RESTORE THE POSITION VECTOR
265:         HRLI AC2,PRGSAV(AC1)    ; THAT WAS STORED LAST TIME THE DPY WAS STOPPED
266:         MOVEM AC2,(AC1)
267:         HRLI AC2,LEB+1(AC1)     ; THE LINE EDITOR DOES THIS TOO
268:         MOVEM AC2,LEPPV+4(AC1)
269:         SETZM LEB(AC1)
270:         HRLI AC2,LEB(AC1)       ; SET UP THE LINE EDITOR CALL
271:         HRRI AC2,DISJMS
272:         MOVEM AC2,LEJMS(AC1)
273:         HRRI AC2,DISJMP         ; FILL UP THE LINE EDITOR BUFFER WITH RETURN JUMPS
274:         MOVEM AC2,LEBUF(AC1)
275:         HRLI AC2,WHOCALL(AC1)   ; MAKE RESTART POINT JUMP BACK TO WHO LINE CALL
276:         MOVEM AC2,RTJMP(AC1)
277:         HRLI AC2,LEBUF(AC1)     ; NOW BLT THE RETURN JUMP ALL OVER THE
278:         HRRI AC2,LEBUF+1(AC1)   ; LINE EDITOR BUFFER.
279:         BLT AC2,LEHPOS-1(AC1)
280:         MOVSI AC3,(TAC)
281:         HRRI AC3,-DPYL0(TAC1)
282:         MOVEM AC3,PRGNUM(DDB)
283:         PUSHJ P,PPINIT          ;GET PAGE PRINTER SET UP FOR EACH DPY.
284:         JRST DPYM7
285:         PUSHJ P,PPSET
286:         JUMPGE TAC,DPYM2
287:         MOVNI AC3,-DPYL0(TAC1)
288:         MOVE AC2,[BYTE (12)0,7777,DISSEL]
289:         MOVEM AC2,PSELC(DDB)
290:         MOVSI AC2,400040        ; NOW MAKE UP SELECT WORD
291:         LSH AC2,(AC3)           ; PUT A BIT IN THE FIRST TWO 12-BIT FIELDS
292:         XOR AC2,[77770000]      ; COMPLEMENT THE SECOND FIELD
293:         ORI AC2,DISSEL
294:         MOVEM AC2,PSELA(DDB)    ; AND THIS IS OUR SELECT WORD
295:         MOVEM AC2,PSELB(DDB)    ; AND OUR SPARE SELECT WORD
296:         AND AC2,[77B5]          ; MASK OUT ALL BUT SELECT BIT
297:         ANDCAM AC2,DPYAVL+1     ; DESELECT THIS CONSOLE FROM AVAILABLE MESSAGE
298:         ANDCAM AC2,WHOSEL       ; DESELECT THIS CONSOLE FROM SYSTEM WHOLINE
299:         LSH AC2,-=12            ; PUT BIT IN 'RESET' FIELD
300:         ORM AC2,DPYAVL+1        ; BE SURE TO RESET THIS CONSOLE TOO
301:         ORM AC2,WHOSEL          ; BE SURE TO RESET THIS CONSOLE TOO
302:         MOVE AC2,[LVW (-5,-14)] ; MAKE A CURSOR FOR THE LINE EDITOR
303:         MOVEM AC2,LEPPV+1(DDB)
304:         MOVE AC2,[LVW (12,0)]
305:         MOVEM AC2,LEPPV+2(DDB)
306:         MOVE AC2,[LVW (-5,14)]
307:         MOVEM AC2,LEPPV+3(DDB)
308:         MOVE AC2,[LVW (0,0,I)]  ; NOW A NULL VECTOR FOR THE LEFT MARGIN
309:         MOVEM AC2,LELMARG(DDB)
    DPYSER page# 0006 next  prev
311: ; MORE INITIALIZE CODE FOR A NEW PROGRAM-LINED-BUFFER THING
312: 
313: DPYM3:  MOVEI AC2,LEBUF+BUFL-4(DDB)
314:         MOVEM AC2,MAXPT(DDB)    ; MAKE UP POINTER TO END OF LINE EDITOR BUFFER
315:         MOVNI AC1,24000/BLKSIZ  ; 24000 WORDS MAXIMUM TOTAL PROGRAMS
316:         MOVEM AC1,BLKTOT(DDB)   ;HOW MANY MORE BLOCKS EACH USER GETS.
317:         HRRZI TAC,-DPYL0(TAC1)
318:         MOVEI AC1,DISNOP
319:         MOVEM AC1,WHOCALL(DDB)  ;NO WHO LINE YET.
320:         MOVEM AC1,LEPOS(DDB)    ; NORMAL VERTICAL POSITION
321:         MOVEM AC1,PGCALL(DDB)   ;NO PG'S.
322:         MOVEM AC1,LEPPV(DDB)
323:         MOVEI AC1,400000
324:         MOVEM AC1,PRGACT(DDB)   ;P OF P 0 ACTIVE.
325:         MOVEM AC1,USRACT(DDB)
326:         MOVEI AC1,3             ; BUMP NUMBER OF SPARE FREE BLOCKS
327:         ADDM AC1,DPYFS+SPFSN
328:         ADDM AC1,SPFSNT
    DPYSER page# 0007 next  prev
330: ; NOW SET UP THE POINTERS IN THE TABLES TO GET THE DP STARTED
331: ; AND STOPPED ON THIS PROGRAM
332: 
333:         HRL AC2,DDB             ; NOW INITIALIZE ALL THE APPROPRIATE TABLES
334:         HRRI AC2,DISJMP         ; THIS LITTLE JUMP GOES TO DPYTAB
335:         HRLI AC3,PRGSTP(DDB)
336:         HRRI AC3,DISJMS         ; THIS LITTLE JUMP GOES TO STPTBL
337:         HRLI AC1,PSELB(DDB)
338:         HRRI AC1,DISJMP         ; AND THIS LITTLE JUMP WENT WEE WEE WEE
339:         MOVEI DAT,LETAB(TAC)    ;Give the header a pointer to
340:         MOVEM DAT,LETBPT(DDB)   ; its LETAB entry.
341:         MOVEI DAT,PSELA(DDB)
342:         CONO PI,PIOFF           ; ALL THE WAY INTO RSTTBL
343:         SKIPE LETAB(TAC)        ; DID SOMEONE SNEAK IN UNDER US?
344:         JRST DPYM5
345:         HRRZM DDB,LETAB(TAC)    ; INITIALIZE LINE EDITOR TABLE TOO
346:         CONO PI,PION
347:         CAIL TAC,DPYNUM
348:         JRST DPYXIT             ;THAT'S ALL FOR DD
349:         MOVEM DAT,SELTBL(TAC)
350:         MOVEM AC3,STPTBL(TAC)   ;IN THIS ORDER
351:         MOVEM AC1,RSTTBL(TAC)   ;WE SHOULDN'T NEED
352:         MOVEM AC2,STRTBL(TAC)   ;TO KEEP PI'S OFF
353: DPYXIT: AOS -6(P)               ;WE HAVE WON
354: DPYXTL: POP P,AC3
355:         POP P,AC2
356:         POP P,AC1
357:         POP P,DDB
358:         POP P,DAT
359:         POP P,TAC
360:         POPJ P,
361: 
362: DPYM5:  CONO PI,PION
363:         CAIL TAC,DPYNUM
364:         JRST DPYM6
365:         PUSHJ P,DPYKFS          ;III - JUST RET FS
366:         JRST DPYXIT
367: 
368: DPYM6:  HRRZM DDB,DPRLSF(DDB)   ;DD - DEFER FS RET FOR DDWIPE
369:         MOVSI TAC,100-DDL0(TAC1)
370:         HLR TAC,PRGNUM(DDB)
371:         PUSHJ P,DDREL           ;BUT GIVE BACK CHNL NOW
372:         JRST DPYXIT
373: 
374: DPYM7:  PUSHJ P,DPYKF2          ;RET HDR
375: DPYM8:  JUMPL TAC,DPYXTL
376:         HRLI TAC,100-DDL0(TAC1)
377:         PUSHJ P,DDREL           ;RELEASE DD CHNL
378:         JRST DPYXTL
379: 
380: ↑PPSET: HRRZM  DDB,HEDPTR(AC1)  ;MAKE PP0 CONT. BLK. POINT AT HEADER.
381:         HRLI AC1,DISJMP         ;ASSEMBLE JMP TO PP 0.
382:         MOVSM AC1,PPCALL(DDB)   ;HAVE HEADER CALL THE PP.
383:         HRRZM AC1,CURPP(DDB)    ;MAKE P OF P 0 THE CURRENT ONE.
384:         MOVEI AC3,PPCALL+1(DDB) ;RETURN ADDR. TO HEADER FROM PP.
385:         HRLM AC3,PPRJMP(AC1)    ;PUT IN PP RETURN JMP.
386:         POPJ P,
    DPYSER page# 0008 next  prev
388: ;GETTING NEW DATA DISC CHANNEL. FIRST DESELECT AVAILABLE MSG,
389: ;THEN ERASE CHANNEL, THEN SELECT CONSOLE TO CHANNEL.
390: 
391: DPYM2:  MOVE AC2,AVLBIT
392:         HRLI DDB,DDWIPE
393:         CONO PI,SCNOFF
394:         ANDCAB AC2,VDMAP-DDL0(TAC1)
395:         MOVEM AC2,VDTMP(DDB)
396:         CONO PI,PIOFF
397:         IDPB DDB,CLKQ
398:         CONO PI,PION!SCNON
399:         JRST DPYM3
400: 
401: ;HERE AT CLOCK LEVEL (CAN'T CALL QBLOCK FROM CH5)
402: DDWIPE: SKIPE DDB,DPRLSF(DAT)
403:         JRST DPYKFS             ;DPYMAKE WAS ABORTED - RET FS NOW
404:         PUSHJ P,GETQ
405:         HRRZ AC2,CURPP(DAT)
406:         ADDI AC2,PPENQ
407:         MOVEM AC2,QCOUNT(AC1)
408:         AOS (AC2)       ;WILL HOLD UP BOTH DPLED & DPYTYP
409:         HRLI DAT,DDMAP
410:         MOVEM DAT,QWAKE(AC1)
411:         JRST LEERS3
412: 
413: ;HERE AFTER ERASE IS FINISHED. NOW THAT CHANNEL IS CLEAN, WE LET HIM SEE IT.
414: DDMAP:  HLRZ AC1,PRGNUM(DAT)
415:         HRRZ TAC,PRGNUM(DAT)
416:         SUBI TAC,DPYNUM
417:         PUSHJ P,VDSTRB
418:         IORM AC3,VDTMP(AC2)
419:         PUSHJ P,VDOUT
420:         MOVEI DAT,DDL0(TAC)
421:         JRST DPYTYP             ;IN CASE PP XFER WAS FLUSHED
    DPYSER page# 0009 next  prev
423: ; ENTER HERE AT CLOCK LEVEL WITH LINE NUMBER IN TAC TO
424: ; FLUSH A DPY BUFFER, IF THAT IS WHAT IS CALLED FOR.
425: 
426: ↑DPYKIL:CAIL TAC,DPYNUM+DDNUM
427:         JRST DPYKER
428:         SKIPE AC1,LETAB(TAC)
429:         SETZM LECLIN(AC1)       ; CLEAR FLAG THAT SAYS CLOCK REQUEST IS IN
430:         SKIPN TTYTAB+DPYL0(TAC) ; FIRST, IS TTYSER THROUGH WITH IT?
431:         SKIPG AC1,LETAB(TAC)
432:         POPJ P,                 ; NO, LEAVE IT AROUND
433:         SKIPE LEACT(AC1)        ; HAS THE LINE EDITOR BEEN ACTIVE IN THE LAST MINUTE?
434:         JRST DPYKI9             ; YES, WAIT ANOTHER MINUTE
435:         SKIPN LEENQ2(AC1)       ; IF HE'S REFRESHING OR HELPING,
436:         SKIPE LEENQ(AC1)        ; OR IF HIS LINE EDITOR IS IN THE QUEUE
437:         JRST DPYKI7             ; PLANT ANOTHER CLOCK REQUEST TO KEEP US AROUND
438:         HLRZ AC2,PPCALL(AC1)    ; OR IF HE HAS ANY PIECE OF PAPER QUEUED
439: DPYKI8: SKIPE PPENQ(AC2)        ; ANYTHING IN QUEUE?
440:         JRST DPYKI7
441:         HRRZ AC2,LINK(AC2)      ; PICK UP POINTER TO NEXT PIECE OF PAPTER CONTROL BLOCK
442:         JUMPN AC2,DPYKI8        ; LOOP BACK IF ANY
443:         HRRZ DDB,AC1
444:         CAIL TAC,DPYNUM
445:         HRLI DDB,400000 ;SET DD FLAG
446:         PUSHJ P,PGCLR           ; CLEAR ANY AND ALL PIECES OF GLASS
447:         CONO PI,PIOFF
448:         SKIPN TTYTAB+DPYL0(TAC) ; ONE LAST CHECK!
449:         SKIPG LETAB(TAC)
450:         JRST DPYKI3
451:         SETZM LETAB(TAC)
452:         JUMPL DDB,DPYKL1
453:         SETZM RSTTBL(TAC)
454:         SETZM STPTBL(TAC)
455:         SETZM STRTBL(TAC)
456: DPYKL1: CONO PI,PION
457:         HRRZ AC2,DDB
458:         SKIPA J,JOBNM1
459: DPYKML: SETZM DPYMAP+1(J)               ;CLEAR GUY MAPPED TO US
460:         CAIE AC2,@DPYMAP(J)
461:         SOJG J,.-1
462:         SOJGE J,DPYKML
    DPYSER page# 0010 next  prev
464:         PUSHJ P,DPYKFS          ;GIVE ALL THE CORE BACK
465:         JUMPGE DDB,DPYK11       ;JUST DIDDLE SELECT FOR III
466: DPYK10: MOVSI TAC,100-DPYNUM(TAC)
467:         HLR TAC,PRGNUM(DDB)
468:         PUSHJ P,DDREL
469:         MOVEI AC1,(TAC)
470:         LDB TAC,[220600,,TAC]
471:         PUSHJ P,VDBIT
472:         ANDCAB AC3,VDMAP(TAC)
473:         JUMPN AC3,VDOUT         ;FORGET AVAIL MSG IF SOMETHING ELSE ON SCREEN
474:         MOVE AC3,AVLBIT
475:         IORM AC3,VDMAP(TAC)
476:         JRST VDOUT
477: 
478: DPYK11: MOVNS TAC
479:         MOVSI AC1,400000        ; PUT A BIT IN THE CONSOLE SELECT POSITION
480:         LSH AC1,-=12(TAC)       ; PUT IT IN THE RESET PART FIRST
481:         ANDCAM AC1,DPYAVL+1     ; DON'T RESET US
482:         ANDCAM AC1,WHOSEL       ; DON'T RESET US FOR WHOLINE EITHER
483:         LSH AC1,=12             ; PUT IT IN THE SELECT POSITION
484:         ORM AC1,DPYAVL+1        ; SELECT THIS CONSOLE
485:         ORM AC1,WHOSEL          ; SELECT THIS CONSOLE FOR SYS WHO LINE
486:         POPJ P,                 ; BYE NOW.
487: 
488: DPYKI3: CONO PI,PION
489:         POPJ P,
490: 
491: DPYKFS: MOVNI AC2,3
492:         MOVEI AC3,DPYFS
493:         PUSHJ P,SFSREL          ;GIVE BACK SPARE TEXT BLOCKS
494:         HLRZ DAT,PPCALL(DDB)
495:         JUMPE DAT,DPYKF2        ;NO PAGE PRINTER
496: DPYKF1: MOVE AC1,FBLKPT(DAT)
497:         PUSHJ P,FREEL           ;RELEASE TEXT BLOCKS
498:         HRRZ AC1,PTB(DAT)
499:         JUMPE AC1,.+2
500:         PUSHJ P,FSGIVE          ;& LINE POINTER TABLE
501:         MOVE AC1,DAT
502:         HRRZ DAT,LINK(DAT)      ;GET POINTER TO NEXT P. OF P.
503:         PUSHJ P,UGIVFS          ;BECAUSE THIS ONE'S GOING AWAY
504:         JUMPN DAT,DPYKF1        ;KEEP GOING IF MORE
505: DPYKF2: MOVEI AC1,(DDB)
506:         JRST UGIVFS             ;NOW RETURN HEADER
    DPYSER page# 0011 next  prev
508: ; WE GET HERE TO PLANT ANOTHER CLOCK REQUEST TO COME BACK
509: ; LATER TO TRY AND KILL THE DAMN THING.
510: 
511: DPYKI9: SETZM LEACT(AC1)        ; CLEAR THE ACTIVE FLAG
512:         SKIPA AC3,DPYKRQ
513: DPYKI7: MOVE AC3,[XWD DPYKILL,1]
514:         SETO AC2,               ; SET FLAG SAYING THERE IS A CLOCK REQUEST IN
515:         EXCH AC2,LECLIN(AC1)
516:         JUMPL AC2,CPOPJ         ; IF THERE ALREADY IS A CLOCK REQUEST IN, DON'T BOTHER TO SET ANOTHER
517:         LSH TAC,=12             ; SHIFT LINE NUMBER OVER TO DATA POSITION
518:         ADD TAC,AC3             ; HAVE US COME BACK HERE IN 1 TICK
519:         CONO PI,PIOFF
520:         IDPB TAC,CLOCK(PID)
521:         CONO PI,PION
522:         POPJ P,
523: 
524: ; THIS ROUTINE PRINTS AN ERROR MESSAGE WHEN THE GIVEN
525: ; LINE NUMBER IS ILLEGAL.
526: 
527: DPYKER: PUSH P,TAC              ; SAVE THE ILL NUMBER
528:         PUSHJ P,DISERR          ; GIVE OUR ERROR MESSAGE
529:         [ASCIZ /ILLEGAL LINE NUMBER AT DPYKILL - /]
530:         DISARG OCT,<-1(P)>
531:         [ASCIZ /
532: /]
533:         -1
534:         POP P,TAC
535:         POPJ P,
536: 
537: ↑DPYKRQ:        DPYKIL,,=15*=60 ;TIME TO WAIT BEFORE KILLING CONSOLE
    DPYSER page# 0012 next  prev
539: ; HERE ARE THE INTERRUPT ROUTINES FOR RUNNING THE DP.
540: 
541: 
542: 
543: ↑DPYINT:        BEGIN DPYINT
544: 
545: DP←←430         ;DEVICE NO. OF DISPLAY PROCESSOR.
546: DPYCHL←<FOR @$ QQ←DPYCHN,DPYCHN {CH$QQ}>        ;PI CHANNEL 3 IS WHERE IT'S AT.
547: DPCONB←←40      ;THE `CONTINUE' BIT FOR THE  DP.
548: DPNULL←←0
549: DPNXM←←2000     ; THE NON-EX MEM BIT
550: DPINT←←4000     ; INTERRUPT REQUEST
551: DPSTOP←←200     ; SET NOT RUNNING
552: DPCHK←←400      ; ERROR CHECK FLAG
553: 
554:         CONSO DP,400000         ;IS IT REALLY STOPPED ?
555:         JEN @DPYCHL             ;NO. 
556:         EXCH TAC,DRUNCT         ;GET NO. OF DPY WHICH HAS BEEN ON.
557:         SKIPN STPTBL(TAC)       ; STOP HIM HERE ONLY IF HE HAS A STOP TABLE
558:         JRST NOSTOP
559:         DATAO DP,STPTBL(TAC)    ;STOP DP AT RIGHT PRGM HEADER.
560:         MOVEM TAC1,@SELTBL(TAC)
561:         CONI DP,TAC1            ;SAVE CURRENT SELECTION FOR NEXT TIME
562:         HRRI TAC1,DISSEL
563:         EXCH TAC1,@SELTBL(TAC)
564: NOSTOP: CONSZ DP,DPNXM!DPCHK    ; HIT A NON-EX MEM OR ERROR CHECK?
565:         JRST DPERR              ; YES, PROCESS IT
566: L6:     SOJL TAC,L1             ;NEXT PRGM TO RUN. (6 PRGMS ALWAYS ARE RUNNING)
567: L5:     CONSO DP,400000         ;MAKE SURE HE FINISHED STOPPING
568:         JRST L5
569:         SKIPE RSTTBL(TAC)       ;DOES HE WANT TO START FROM THE FRONT ?
570:         JRST L2                 ;YES.
571:         SKIPN STRTBL(TAC)       ; IS THERE A PROGRAM THERE?
572:         JRST L7
573:         DATAO DP,STRTBL(TAC)    ;NO.  START HIM AT NORMAL PLACE.
574: L3:     EXCH TAC,DRUNCT         ;PUT THINGS BACK.
575:         ROT 44
576:         CONO DP,DPCONB+DPYCHN+740000+1000       ;START DP AND CLEAR MASKS.
577:         JEN @DPYCHL             ;RETURN TO WHOMEVER.
    DPYSER page# 0013 next  prev
579: ;HERE WE HAVE AND ERROR - - PRINT A MESSAGE AND CHECK THE SYSTEM!
580: 
581: DPERR:  EXCH P,APRPDL+P1PID     ; GET A STACK
582:         PUSHACS                 ; GET US SOME AC'S
583:         MOVEI PID,P1PID
584:         MOVEM TAC,SAVTAC                ;SAVE DP #
585:         CONI DP,DPCNI           ;GET SOME BITS
586:         PUSHJ P,DISDATE
587:         PUSHJ P,DISERR
588:         [ASCIZ/DP ERROR.
589: CONI BITS = /]
590:         DISARG LOC,DPCNI
591:         [ASCIZ/
592: DPY# = /]
593:         DISARG LOC,SAVTAC
594:         -1
595:         MOVE AC3,SAVTAC
596:         SKIPN AC3,STPTBL(AC3)
597:         JRST NOADDR
598:         HLRZS AC3
599:         HLRZ AC3,(AC3)          ;GET MA
600:         PUSHJ P,DISERR
601:         [ASCIZ/    MA = /]
602:         DISARG LOC,AC3
603:         [ASCIZ/
604: /]
605:         -1
606:         CAILE AC3,1
607:         CAMLE AC3,RMEMSIZ       ;IS IT LEGAL?
608:         JRST ADDRCK
609:         PUSHJ P,DISERR
610:         [ASCIZ\MA-2/   \]
611:         DISARG OCT,-2(AC3)
612:         [ASCIZ\
613: MA-1/   \]
614:         DISARG OCT,-1(AC3)
615:         [ASCIZ\
616: MA/     \]
617:         DISARG OCT,(AC3)
618:         -1
619:         JRST NOADDR
620: ADDRCK: PUSHJ P,DISMES
621:         ASCIZ/NON-EX ADDRESS/
622: NOADDR: PUSHJ P,DISMES
623:         ASCIZ/
624: 
625: 
626: /
627:         PUSHJ P,SYSFIX          ;CHECK SYSTEM FOR CLOBBERING
628:         JFCL                    ;OK
629:         JFCL                    ;NOT OK
630:         SKIPN DEBMOD            ;DOES HE WANT TO LOOK AT IT?
631:         JRST NODPLK             ;NO
632:         SETOM DISFLAG
633:         PUSHJ P,DISFLUSH        ;FORCE OUT THE REST
634:         PUSHJ P,DDTCALL         ;AND CALL DDT
635: NODPLK:
636:         MOVEI TAC,DPYNUM-1      ;RESTART ALL DISPLAYS
637: L8:     SKIPN DDB,LETAB(TAC)
638:         JRST L9                 ; IF NONE THERE, LOOP
639:         HRLI DDB,PSELB(DDB)     ; ARRANGE TO RESTART AT TOP AGAIN
640:         HRRI DDB,DISJMP
641:         MOVEM DDB,RSTTBL(TAC)
642: L9:     SOJGE TAC,L8            ; GET THEM ALL!
643:         POPACS                  ; GET BACK AC'S
644:         EXCH P,APRPDL+P1PID     ; AND WHATEVER WAS IN P
645:         JRST L6                 ; AND DO NEXT GUY
    DPYSER page# 0014 next  prev
647: ; DP INTERRUPT CODE - RESTART PROGRAM, LOOP AROUND OF NEXT DPY, STOP DP, SET AVAILABLE MESSAGE
648: 
649: L2:     DATAO DP,RSTTBL(TAC)    ;START GUY AT BEGINNING OF HIS PRGM.
650:         SETZM RSTTBL(TAC)       ;...THIS TIME ONLY.
651:         JRST L3
652: 
653: L1:     SKIPE DPYHOL            ; HAS THE HOLDING MESSAGE GONE OUT YET?
654:         JRST L1A                ; YES, CONTINUE WITH OUR BUSINESS
655:         SETOM DPYHOL
656:         DATAO DP,[XWD DPYHLD,DISJMP]
657:         JRST L3
658: 
659: L1A:    SETZM DPYHOL
660:         MOVEI TAC,DPYNUM-1      ;WE'VE RUN `EM ALL.
661:         SETZM DPYARN            ; NOTE THAT THEY HAVE ALL BEEN RUN
662:         AOSE DSFLAG             ;HAS CLOCK TICKED ?
663:         AOJA TAC,L4             ;NO. IT'S NOT YET TIME TO START OVER.
664:         JRST L5
665: 
666: L4:     CONO DP,DPNULL          ;SHUT DOWN THE DP.
667:         EXCH TAC,DRUNCT
668:         JEN @DPYCHL
669: 
670: L7:     SKIPE DPYARN            ; HAS THE 'CONSOLE AVAILABLE' MESSAGE GONE OUT YET?
671:         JRST L6                 ; YES
672:         SETOM DPYARN            ; NO, IT WILL.
673:         DATAO DP,[XWD DPYAVL,DISJMP]
674:         JRST L3                 ; GO START UP DP AND LEAVE
675: 
676: BEND
    DPYSER page# 0015 next  prev
678: ;PPINIT         PAGE PRINTER STUFF
679: 
680: COMMENT  ⊗      THIS IS THE ABODE OF THE FEARSOME PAGE PRINTER.
681:         IT ALLOWS EACH LUCKY USER (IF HE IS OBEDIENT) TO HAVE
682:         UP TO 16 PIECES OF PAPER (OR REASONABLE FACSIMILE
683:         THEREOF), ON ANY OF WHICH HE CAN TYPE AND DRAW IN
684:         DIVERSE WAYS, AND WHICH CAN BE ROLLED BACKWARD AND
685:         FORWARD AND DISPLAYED SEPARATELY OR IN ARBITRARY
686:         COMBINATION WITH OTHER DISPLAYS.
687:                 EACH PIECE OF PAPER CONSISTS OF A LINKED
688:         SET OF BLKS FROM FREE STORAGE AND ONE CONTROL BLOCK,
689:         ALSO FROM FREE STORAGE. THE CONTROL BLOCK IS LINKED
690:         TO THE PROGRAM HEADER AND TO THE CONTROL BLOCKS FOR ANY
691:         OTHER PIECES OF PAPER BELONGING TO THE SAME PROGRAM.
692: ⊗
693: 
694: OUTNUM←←1       ;THIS MANY BLOCKS AT ONCE GET PUT ON DISK.
695: LINELN←←=88     ;NO. OF CHARS. PER LINE.
696: DDLINELN←←=84   ; SAME AS ABOVE FOR DATA DISK
697: CBLKBT←←1;      ;MAGIC CODE BITS FOR THE (HO, HO) RELOCATING GARBAGE COLLECTOR.
698: TBLKBT←←4
699: FBLKBT←←2
700: 
701: ↑PPINIT:                        ;INITIALIZE A PAGE PRINTER WITH PIECE OF PAPER 0.
702:         PUSHJ P,PPFSGET         ;GET A BLOCK OF FREE STORAGE.
703:         POPJ P,                 ; NO FREE STORAGE, GIVE ERROR RETURN
704:         HRR AC3,AC2             ;MAKE BLT POINTER.
705:         HRRZ DAT,AC2
706:         HRLI AC3,PPMODL
707:         BLT AC3,BLKSIZ-1(AC2)   ;INIT. THE CONTROL BLK. BY COPYING THE PROTOTYPE INTO IT.
708:         PUSHJ P,PPFSGET         ;GET A BLOCK FOR FIRST PART OF PRGM.
709:         JRST PPI1               ; NO FREE STORAGE, RELEASE PREVIOUS BLOCKS AND GIVE ERROR RETURN
710:         MOVEM AC2,CBLKPT(DAT)   ;MAKE IT CURRENT BLOCK...
711:         MOVEM AC2,FBLKPT(DAT)   ;.. AND FIRST BLOCK IN CORE...
712:         MOVEM AC2,TBLKPT(DAT)   ;... AND TOP BLK BEING DISPLAYED.
713:         HRRM AC2,PPTR1(DAT)     ;MAKE BYTE POINTER FOR TYPING POINT
714:         SOS PPTR1(DAT)          ;ONE BEFORE BOTTOM OF BLOCK.
715:         HRLM AC2,TPJMP(DAT)     ;FIX UP JMP TO PRGM IN CONT. BLK.
716:         HRLI AC3,TPJMP+1(DAT)   ;RETURN ADDR. FROM PRGM. TO CONT. BLK.
717:         HRRI AC3,DISJMP
718:         MOVEM AC3,(AC2)         ;PUT RETURN JMP IN FIRST WORD OF PRGM.
719:         HRLZM DAT,LINK(AC2)     ;BACKWARD LINK OF PRGM. POINTS TO CONT. BL.K.
720:         SETZM LINK(DAT)         ;ONLY ONE CONT. BLOCK.
    DPYSER page# 0016 next  prev
722:         SETZM PPDD(DAT)         ; ASSUME III UNTIL PROVEN OTHERWISE
723:         MOVEI AC3,LPFS          ; GET SOME FREE STORAGE FOR THE
724:         PUSHJ P,SFSGET          ; LINE POINTER TABLE
725:         JRST PPI3
726:         MOVEM AC1,PTB(DAT)      ; SAVE ADDRESS OF BEGINNING OF BLOCK
727:         ADDI AC1,=20            ; BUMP ADDRESS TO VISIBLE SCREEN PART
728:         HRRM AC1,PTRB(DAT)
729:         MOVE AC2,PPTR1(DAT)     ; INITIALIZE FIRST WORD OF POINTER TABLE
730:         ADD AC1,VPOS(DAT)       ; GET ADDRESS OF FIRST POINTER TO BE USED
731:         MOVEM AC2,(AC1)         ; TO POINT TO FIRST OF TEXT
732:         MOVEM AC2,1(AC1)        ; SAME FOR DD
733:         JUMPL TAC,PPFXT         ;DONE FOR III
734:         SETOM PPDD(DAT)
735:         MOVEI AC1,11            ; SET NUMBER OF LINES IN A GLITCH TO 8
736:         MOVEM AC1,DEL(DAT)
737:         MOVEM AC1,DELCNT(DAT)
738:         MOVEI AC1,4             ; AND NUMBER OF GLITCHES TO 4, SUCH THAT WE GET
739:         MOVEM AC1,PGSIZ(DAT)    ; 32 LINES TO A SCREEN AND DON'T DO A WHOLE PAGE REFRESH TOO OFTEN
740:         MOVEM AC1,VPOS(DAT)
741:         MOVEM AC1,LLW(DAT)
742:         MOVEM AC1,GLW(DAT)
743:         SETZM DDSAV(DAT)        ; CLEAR EXTRA SAVED WORDS
744:         MOVE AC1,[CW 1,46,2,0,3,2]
745:         DPB TAC,[POINT 8,AC1,15]
746:         MOVEM AC1,DDCW(DAT)
747:         MOVEI AC2,DDLINELN      ; SET OUR OWN LINE LENGTH
748:         MOVEM AC2,LNLNGT(DAT)
749:         MOVNM AC2,DPHPOS(DAT)   ; INITIALIZE THE HORIZONTAL POSITION COUNTER
750:         MOVE AC1,[LVW -777,YPDD,I,A,2,2]
751:         MOVEM AC1,PPOSV(DAT)
752:         SETZM TPJMP+1(DAT)
753:         SETZM TPJMP+2(DAT)
754:         MOVE AC1,[CW 3,2,4,0,5,0]
755:         MOVEM AC1,TPJMP+4(DAT)
756: PPFXT:  MOVE AC1,DAT
757:         JRST CPOPJ1
758: 
759: ; WE GET HERE MOSTLY IF A REQUEST FOR FREE STORAGE FOR THE PAGE PRINTER FAILS
760: 
761: PPI3:   HRRZ AC1,CBLKPT(DAT)    ; RETURN FIRST PIECE OF TEXT
762:         PUSHJ P,FSGIVE
763: PPI1:   HRRZ AC1,DAT            ; AND RELEASE CONTROL BLOCK ITSELF
764:         JRST FSGIVE             ; TAKE ERROR RETURN FROM PPINIT
    DPYSER page# 0017 next  prev
766: ; FREE STORAGE HANDLER FOR PAGE PRINTER
767: 
768: PPFSGE: MOVE AC2,AC1
769:         MOVEI AC3,PPFS
770:         AOS (P)
771:         PUSHJ P,SFSGET
772:         SOS (P)
773:         EXCH AC2,AC1
774:         POPJ P,
775: 
776: ;;UGETFS IS FOR GETTING FREE STG. AT UUO LEVEL.
777: 
778: CGETFS: AOSA BLKTOT(DDB)
779: UGFS2:  PUSHJ P,CLKWAT          ;WAIT FOR SOME FS TO APPEAR.
780: ↑UGETFS:                        ;;GET A BLOCK OF FREE STG. FROM JAM.
781:         MOVEI AC3,DPYFS
782:         PUSHJ P,SFSGET
783:         SKIPE AC1,SPWUUF(PID)   ;WE ARE AT CLOCK LEVEL AND THERE'S NO FREE STG.
784:         POPJ P,
785:         SKIPN AC1,INTACT(PID)   ; OR AT USER INTERRUPT LEVEL
786:         JRST UGFS2              ;OOPS, NONE THERE, AND WE ARE NOT IN SPACEWAR MODE.
787:         POPJ P,
788: 
789: ; ROUTINE TO RELEASE FREE STORAGE BLOCKS
790: 
791: CGIVFS: SOS BLKTOT(DDB)         ;DECR. COUNT OF USED BLOCKS...
792: ↑UGIVFS:
793:         CONO PI,PIOFF
794:         MOVE AC2,FSWT2H ;FREE THE BLOCK IN AC1.
795:         HRRZM AC1,FSWT2H
796:         HRRM AC2,LINK(AC1)
797:         CONO PI,PION
798:         AOS FSW2C
799:         POPJ P,
800: 
801: ;GET A DD Q BLOCK
802: GETQ:   PUSH P,AC3
803:         MOVE AC3,[SETZ DDFS]    ;NO SKIP
804:         PUSHJ P,SFSGET
805:         POP P,AC3
806:         POPJ P,
807: 
808: UGETF2: PUSHJ P,CLKWAT
809: UGETF1: PUSHJ P,FSGET
810:         SKIPE AC1,SPWUUF(PID)   ;TOO BAD WE HAVE TO DUPLICATE ALL THIS SHIT
811:         POPJ P,
812:         SKIPN AC1,INTACT(PID)
813:         JRST UGETF2
814:         POPJ P,
    DPYSER page# 0018 next  prev
816: ;BELOW IS THE PROTOTYPICAL P. OF P. CONTROL BLOCK.
817: 
818: DEFINE X (A,B) {A←←.-PPMODL
819:                 B
820:                 }
821: PPMODL:  
822: 
823: X PPOSV,{LVW  -777,YPIII,I,A,2,2}       ;POS VECTOR
824: X TPJMP, DISJMP         ;JMP TO FIRST BLOCK OF PAGE BEING DISPLAYED.
825:         LVW (7,-17,I)   ;NOW DRAW THE CURSOR.
826:         LVW -5,-10
827: X ↑DDCW,<LVW 12,0>
828:         LVW -5,10
829:         LVW (-7,7,I)
830: X PPRJMP, DISJMP        ;JMP BACK TO HEADER OR ON TO NEXT CONT. BLK.
831: 
832: X HEDPTR, 0             ;POINTER BACK TO PRGM HEADER.
833: X OUTCNT,OUTNUM         ;BLOCKS REMAINING BEFORE DISK OUTPUT.
834: X PPNO,0                ;NONO. OF THIS P. OF P.
835: X ↑DPHPOS,-LINELN       ;CHARS. LEFT BEFORE END OF THIS LINE.
836: X CNT1,0                ;CHARS. REMAINING  BEFORE EXTENSION NEEDED.
837: X PPTR1,{POINT 7,0,35}  ;CURRENT POINTER FOR PRINTING ON THIS PIECE OF PAPER.
838: X SPTR1,0               ; SAVED POINTER FOR ZEROING OUT SPACE BEFORE CR
839: X WCNT,-INITWC          ;FREE WORDS LEFT IN CURRENT BLOCK.
840: X CBLKPT,0              ;BOTTOM OF CURRENT BLOCK.
841: X TBLKPT,0              ;FIRST BLOCK CURRENTLY DISPLAYED (AT TOP OF SCREEN)
842: X FBLKPT,0              ;FIRST BLOCK STILL IN CORE.
843: X DEL,2                 ; NO. OF LINES IN A GLITCH.
844: X DELCNT,2              ;LINES REMAINING IN CURRENT GLITCH.
845: X GLCNT,1               ;CURRENT SIZE OF PAGE IN GLITCHES.
846: X PGSIZ,14              ;NOMINAL SIZE OF PAGE IN GLITCHES.
847: X PTBEG,0               ; INCREMENT INTO LINE POINTER TABLE
848: X DDSPT,0               ;POINTS TO SAVED WORD FROM FIRST REFRESHED LINE (DD)
849: X DDSAV,0               ;SAVED WORD FROM FIRST REFRESHED LINE (DD)
850:         0
851: X (↑VPOS,3)             ;LINE NUMBER OF CURRENT LINE
852: X LLW,3                 ; LAST LINE WRITTEN
853: X PTRB,<XWD AC3,0>      ;POINTS TO TABLE OF BYTE POINTERS TO THE FIRST OF EACH LINE (DD)
854: X PTB,0                 ; ACTUAL TABLE ADDRESS
855: X VP,0                  ; VERTICAL POSITION ARGUEMENT TO QDD
856: X SC,0                  ; ARGUEMENT TO QDD FOR COUNT FIELD ADDRESS
857: X DPYCHR,0              ; FLAG SAYING AT LEAST ONE CHARACTER HAS BEEN TYPED
858: X LSTCHR,12             ; LAST CHARACTER DEPOSITED INTO BUFFER
859: X GLW,3                 ; GREATEST LINE WRITTEN, FOR ERASING WHEN WE GLITCH
860: X PPDD,0                ; DATA DISK FLAG
861: X GLTCH,0               ; FLAG THAT SAYS THE PAGE PRINTER HAS GLITCHED
862: X PPINV,0               ; FLAG INDICATING PAGE PRINTER POINTERS ARE BEING MODIFIED
863: X PPENQ,0               ; NUMBER OF TASKS THIS PAGE PRINTER HAS IN THE DD QUEUE
864: X PPNQT,0               ; COUNT DOWN FOR NON-PAGE PRINTER REQUESTS
865: X PPVIRG,-1             ; INDICATES VIRGIN PAGE PRINTER
866: X ↑LNLNGT,LINELN        ;LINELENGTH FOR THIS GUY.
867: 
868: 
869: ; ALL DISPLAY PROGRAM SPACE IS TAKEN FROM A FREE
870: ;  STORAGE AREA CONSISTING OF FIXED SIZE BLOCKS.  THE
871: ; FOLLOWING PARAMETERS RELATE TO THOSE BLOCKS.
872: 
873: ↓BLKSIZ←←<<LNLNGT+5+1>!<TRIVIAL-1>>-1   ;BLOCK SIZE. THIS IS ARBITRARY, BUT ≥36
874: ↑BLKSIZ←←BLKSIZ
875: ↓LINK ←← BLKSIZ-1       ;LINKS IN LAST WD OF BLK: XWD BACK,FORWARD
876: ↓BLKBTS ←← LINK-1       ;MAGIC TYPE BITS FOR BLK GO HERE.
877: ↓GCINFO ←← BLKBTS-1     ;INFO FOR THE (HYPOTHETICAL) GARBAGE COLLECTOR
878: FSBSIZ←←BLKSIZ-2        ;BLKSIZ FOR OUTSIDE WORLD.
879: ↑FSLINK←←LINK
880: ↓CNT←←GCINFO-2          ;MAX. NO. OF `GLITCHES' PER PAGE.
881: INITWC←←GCINFO-2        ;THIS MANY WORDS/BLOCK AVAILABLE FOR PROGRAM.
    DPYSER page# 0019 next  prev
883: ;TYO, DPYTYO.
884: 
885: ;TYO: CHARACTER IN CHR, DAT POINTS TO P.OF P. CONTROL BLOCK.
886: 
887: ;???PRINT IS CALLED WITH A BYTE PTR. IN TAC AND A
888: ;POSITIVE CHAR. COUNT IN TAC1 AND DAT POINTING TO CONTROL BLOCK.
889: 
890: 
891: ↑↑DPYTYO:
892:         MOVE DAT,CURPP(DDB)     ; PICK UP POINTER TO PAGE PRINTER CONTROL BLOCK
893:         HLL DAT,DDB             ; PUT IN DD BIT
894:         JRST TYO
895: 
896: TYOTAC: ILDB CHR,TAC            ;PRINT NEXT CHR IN STRING POINTED TO BY TAC.
897: TYO:    MOVE    AC1,LSTCHR(DAT) ; PICK UP LAST CHARACTER TYPED
898:         CAIN    AC1,177         ;IF A DELETE ON DATA DISC
899:         JUMPL   DAT,DELNOW      ;ON DD, <DELETE><CHR> IS A SINGLE NORMAL GRAPHIC.
900:         JUMPE   CHR,CPOPJ       ;DON'T PRINT NULLS.
901:         JUMPGE  AC1,TYO0        ;JUMP UNLESS THE LAST THING WE DID WAS INVENT CRLF.
902:         CAIN    CHR,15          ;A CR AFTER WE INVENTED A CRLF?
903:         POPJ    P,              ;YES. SUPPRESS IT.
904:         MOVEI   AC1,12          ;MAKE IT LOOK LIKE THE LAST CHARACTER WAS LF.
905:         MOVEM   AC1,LSTCHR(DAT) ;SET IT.
906:         CAIN    CHR,12          ;CHARACTER IS LF?
907:         POPJ    P,              ;YES. SUPPRESS THAT TOO.
908:                                 ;NOW IT LOOKS LIKE NORMAL CHARACTER, LSTCHR SET.
909: 
910: TYO0:   SETOM DPYCHR(DAT)       ; NOTE THAT ANOTHER CHARACTER HAS BEEN TYPED
911:         CAIN CHR,15             ; IS IT A CR ?
912:         JRST PR1ECR             ; YES, GO SERVICE IT
913:         CAIE AC1,12             ; WAS LAST CHARACTER A LF?
914:         JRST TYO1               ; NO
915:         JUMPG DAT,TYO1          ; IF III, WE CAN SKIP ALL THIS BULLSHIT
916: 
917: ;ON DD. FIRST CHARACTER AFTER LF.
918:         MOVE AC1,DPHPOS(DAT)    ; WELL, ARE WE AT THE BEGINNING OF THE LINE?
919:         ADD AC1,LNLNGT(DAT)
920:         JUMPE AC1,TYO4          ; YES, THERE MUST HAVE BEEN A CR FIRST.
921:         PUSH P,CHR              ; SAVE OUR CHARACTER
922:         PUSH P,AC1              ; SAVE THE COUNT (I.E., COLUMN NUMBER.)
923:         MOVEI CHR,15            ; TYPE A CR FIRST
924:         DPB CHR,SPTR1(DAT)      ; REPLACE LF WITH CR
925:         MOVEI CHR,12            ; PUT OUR LF BACK
926:         SOS VPOS(DAT)
927:         PUSHJ P,PUTCH1
928:         PUSHJ P,EOLSET          ; STORE THE POSITION OF OUR NEW LF
929:         MOVEI CHR,40            ; THEN PAD OUT THE LINE
930: ;TYPE A BUNCH OF SPACES TO SIMUALTE A BARE LINE FEED.
931: TYO5:   PUSHJ   P,PUTCH1        ;SEND A SPACE.
932:         SOSLE   (P)             ;DECREMENT THE SPACE COUNT.
933:         JRST    TYO5            ;LOOP SPACING.
934:         SUB     P,[1,,1]        ;ADJUST STCK TO REMOVE SPACE COUNT.
935:         POP     P,CHR           ;RESTORE CHARACTER. FALL INTO TYO1
936: 
937: TYO1:   CAIN CHR,12             ; OR A  LINE FEED ?
938:         JRST PR1EOL             ;YES.
939:         JUMPGE DAT,TYO2         ; IF III, JUST PUT THE CHARACTER IN THE BUFFER
940:         MOVE AC1,DPHPOS(DAT)    ; ARE WE AT THE LEFT MARGIN?
941:         ADD AC1,LNLNGT(DAT)
942:         JUMPN AC1,TYO2          ; NO
943:         MOVE AC1,LSTCHR(DAT)    ; YES, WAS LAST CHARACTER A LF?
944:         CAIN AC1,12
945:         JRST TYO2
946:         PUSH P,CHR              ; NO, PUT ONE IN!
947:         MOVEI CHR,12
948:         PUSHJ P,PUTCH1
949:         PUSHJ P,EOLSET          ; STORE LINE POINTER
950:         SOSG DELCNT(DAT)        ; TIME TO GLITCH YET?
951:         PUSHJ P,PREOGL          ; YES, DO IT.
952:         POP P,CHR
953: TYO2:   CAIN CHR,11             ; TAB?
954:         PUSHJ P,PR1TAB          ; YES, GO EXPAND IT.
955:         PUSHJ P,PUTCH1          ; PUT CHARACTER INTO BUFFER
956: TYO7:   MOVEM CHR,LSTCHR(DAT)   ; SAVE LAST CHARACTER
957:         CAIN    CHR,177         ;IS THIS A DELETE?
958:         JUMPL   DAT,.+3         ;YES. FOR DD AVOID CHANGING THE H.POSITION.
959:         AOSL DPHPOS(DAT)        ;UPDATE HORIZONTAL POS.
960:         JRST PRCR               ;OVER END OF LINE..  INSERT CR LF.
961:         MOVE AC1,[CW 0,0,3,2,3,2]
962:         SKIPGE DAT              ; IF WE ARE A DD
963:         MOVEM AC1,TPJMP+1(DAT)  ; AND THE LINE DOESN'T END WITH CRLF, PUT IN AN EXECUTE
964:         POPJ P,
    DPYSER page# 0020 next  prev
966: ; WE GET HERE IF THE LAST CHARACTER WAS A LF AND WE ARE AT THE LEFT MARGIN
967: TYO4:   CAIE CHR,12             ; IS THIS CHARACTER A LF?
968:         JRST TYO2               ; NO, JUST DUMP THE CHARACTER IN THE BUFFER
969:         PUSHJ P,PR1EC2          ; YES, PUT IN A SPACE, CR, AND A LF
970:         MOVEI CHR,12            ; PICK UP A LF
971:         JRST PR1EOL
972: 
973: ;PRINT SINGLE CHAR. FROM CHR., WITH NO SPEC. CHAR. CHECKING.
974: PUTCH1: SOSG CNT1(DAT)
975:         PUSHJ P,EXTBUF          ;GO EXTEND BUFFER.
976:         IDPB CHR,PPTR1(DAT)
977:         POPJ P,
978: 
979: ;DD. LAST CHARACTER WAS A DELETE. THIS CHARACTER WILL MAKE AN ORDINARY GRAPHIC.
980: DELNOW: PUSHJ P,PUTCH1          ;PUT CHARACTER IN BUFFER
981:         IORI CHR,200            ;MAKE IT SPECIAL SO WE WON'T COMPARE EQUAL TO IT
982:         JRST TYO7
983: 
984: 
985: ;WE GET HERE TO PRINT SPACES FOR A TAB
986: PR1TAB: PUSHJ P,PUTCH1          ;HANDLE A TAB. FIRST PRINT THE TAB.
987:         MOVEI CHR," "           ;NOW OUTPOOT RIGHT NO. OF SPACES.
988:         SETCM AC1,DPHPOS(DAT)   ;GET CURRENT POS. ON LINE..
989:         SUB AC1,LNLNGT(DAT)     ; MAKE TABS START IN COLLUMN 8
990:         ANDI AC1,7              ;GET NO. OF SPACES TO NEXT MULTIPLE OF 8 BOUNDARY.
991:         ADDM AC1,DPHPOS(DAT)    ;UPDATE HIM.
992: PR1TB1: PUSH P,AC1              ; SAVE OUR COUNT
993:         PUSHJ P,PUTCH1          ;NOW EMIT A SPACE.
994:         POP P,AC1
995:         SOJGE AC1,PR1TB1        ;..AND SOME MORE, IF APPROPRIATE.
996:         MOVEI CHR,11            ;WE WILL FINISH OFF WITH ANOTHER TAB..
997:         POPJ P,
998: 
999: ;STICK A CRLF IN TO BREAK UP LONG LINES
1000: PRCR:   MOVEI CHR,15            ;PRINT A CR.
1001:         PUSHJ P,PUTCH1
1002:         MOVEI CHR,12            ;NOW INVENT A LINE FEED.
1003:         PUSHJ P,SETLL           ; RESET DPHPOS
1004:         PUSHJ   P,PR1EOL        ;GO DO THE END-OF-LINE BIT
1005:         SETOM   LSTCHR(DAT)     ;FLAG THAT WE INVENTED CRLF HERE.
1006:                                 ;(DPYTYP WILL WAIT FOR LINE BEFORE SENDING MORE)
1007:         POPJ    P,
    DPYSER page# 0021 next  prev
1009: PR1ECR: JUMPGE DAT,PR1EC1       ; IS THIS A DD?
1010:         SETZM TPJMP+1(DAT)      ; IF SO, THE LINE WILL BE ACTIVATED, SO KILL THE EXECUTE
1011:         MOVEI AC1,12            ; WAS THE LAST CHARACTER A LF
1012:         CAME AC1,LSTCHR(DAT)
1013:         JRST PR1EC1
1014:         MOVN AC3,DPHPOS(DAT)    ; PICK UP THE HORIZONTAL POSITION
1015:         CAMN AC3,LNLNGT(DAT)    ; ARE WE AT THE BEGINNING OF THE LINE?
1016:         JRST PR1EC2             ; YES, NO NEED FOR ANY MORE CR'S
1017:         SOS VPOS(DAT)
1018:         DPB CHR,SPTR1(DAT)      ; PUT THE CR IN OVER THE LF
1019:         PUSHJ P,SETLL           ; RESET DPHPOS
1020:         MOVEI CHR,12
1021:         PUSHJ P,PUTCH1          ; STICK THE LF IN
1022:         MOVEM CHR,LSTCHR(DAT)   ; SAVE IT
1023:         JRST EOLSET             ; DO THE END-OF-LINE BIT
1024: 
1025: PR1EC1: MOVN AC3,DPHPOS(DAT)    ; NOW (SIGH) SEE IF WE ARE AT THE LEFT MARGIN!
1026:         CAMN AC3,LNLNGT(DAT)
1027:         POPJ P,                 ; IF SO, FLUSH THIS CR
1028:         PUSHJ P,SETLL           ; RESET DPHPOS
1029: PR1EC3: PUSHJ P,PUTCH1          ; YES, DUMP ONE OF THEM
1030:         MOVEM CHR,LSTCHR(DAT)
1031:         POPJ P,
1032: 
1033: ; WE GET HERE IF THE LAST CHARACTER WAS A LF AND WE ARE AT THE LEFT MARGIN
1034: PR1EC2: MOVEI CHR,40            ; PRINT A SPACE SO THE LINE WILL GET ERASED
1035:         PUSHJ P,PUTCH1
1036:         MOVEI CHR,15
1037:         JRST PR1EC3
1038: 
1039: ; HERE ON LF
1040: PR1EOL: SKIPGE DAT              ; IS THIS A DD?
1041:         SETZM TPJMP+1(DAT)      ; YES, NO NEED FOR AN EXECUTE AT THE END OF THE BUFFER.
1042: PR1EO1: MOVEM CHR,LSTCHR(DAT)   ; SAVE THIS CHARACTER
1043:         PUSHJ P,PUTCH1          ;HERE AT END OF LINE. PRINT LINE FEED.
1044:         PUSHJ P,EOLSET          ; YES, SET VERTICAL POSITION AND SAVE BYTE PTR
1045:         SOSLE DELCNT(DAT)       ;ARE WE AT THE TOP OF A GLITCH ?
1046:         POPJ P,                 ;NO. GO BACK.
1047: PREOGL: MOVE AC3,DEL(DAT)       ;GET NO. OF LINES PER GLITCH..
1048:         MOVEM AC3,DELCNT(DAT)   ;.. AND INIT. THE COUNT.
1049:         AOS AC1,GLCNT(DAT)      ;UPDATE SIZE OF PAGE.
1050:         CAMG AC1,PGSIZ(DAT)     ;IS IT TOO BIG ?
1051:         POPJ P,                 ; NOT YET.
1052:         JRST GLITCH             ; YES, MOVE IT UP SOME
1053: 
1054: ;INITIALIZE LENGTH OF THE LINE AT CR.
1055: SETLL:  MOVN AC1,LNLNGT(DAT)    ;GET -LINELENGTH.
1056:         MOVEM AC1,DPHPOS(DAT)   ;RESET HORIZONTAL POS.
1057:         POPJ P,
    DPYSER page# 0022 next  prev
1059: BEGIN EXTBUF    ;MAKE MORE ROOM IN THE DISPLAY BUFFER.
1060: 
1061: ↑EXTBUF: EXCH AC1,PPTR1(DAT)    ;GET BYTE POINTER.
1062: L2:     MOVN AC2,WCNT(DAT)      ;HOW MANY WORDS LEFT IN THIS BLOCK ?
1063:         JUMPE AC2,GBLK          ;IF NONE, GET A NEW BLOCK.
1064:         CAILE AC2,10            ;IF FEWER THAN 8, USE THAT  NO.
1065:         MOVEI AC2,10            ;..ELSE USE 8 WORDS.
1066:         ADDM AC2,WCNT(DAT)      ;DECREMENT THE COUNT.
1067:         MOVE AC3,AC2
1068:         ASH AC3,2               ;MULTIPLY BY 5 RAPIDLY.
1069:         ADD AC3,AC2
1070:         MOVEM AC3,CNT1(DAT)     ;THAT'S THE NEW CHAR. COUNT, FOLKS.
1071:         MOVE AC3,1(AC1)         ;PICK UP THE JMP AT CURRENT END OF BUFFER..
1072:         ADDI AC1,1(AC2)         ;GET NEW POS. FOR IT...
1073:         MOVEM AC3,(AC1)         ;.. AND PUT IT THERE.
1074:         MOVEI AC3,1             ;MANUFACTURE A NULL CHAR. WORD...
1075: L1:     SUBI AC1,1              ;AND FILL THE NEWLY AVAILABLE AREA OF THE
1076:         MOVEM AC3,(AC1)         ;BUFFER WITH IT.
1077:         SOJG AC2,L1
1078:         SUBI AC1,1
1079:         TLZ     AC1,760000              ;BUG FIX REG RPH 24 JUL 72
1080:         EXCH AC1,PPTR1(DAT)     ;RESTORE THINGS TO THEIR RIGHTFUL PLACES.
1081:         POPJ P,
1082: 
1083: GBLK:  ;;GET ANOTHER BLOCK FROM FREE STORAGE FOR PRGM.
1084:         AOSLE BLKTOT(DDB)       ;INC. HIS COUNT OF BLOCKS USED.
1085:         PUSHJ P,FBLK            ;OOPS, TOO MANY. FREE SOME.
1086:         PUSHJ P,GETFS           ;GET ANOTHER BLOCK FROM FREE STORAGE.
1087:         HRR AC1,AC2             ;MAKE THE BYTE PTR. POINT THERE.
1088:         EXCH AC2,CBLKPT(DAT)    ;UPDATE CURRENT BLK. PTR (AND GET OLD ONE).
1089:         MOVEI AC3,CBLKBT        ;GC BIT FOR `CURRENT PP BLOCK'...
1090:         ANDCAM AC3,BLKBTS(AC2)  ;..TURN IT OFF IN OLD BLOCK.
1091:         MOVEM AC3,BLKBTS(AC1)   ;.. AND PLACE IN NEW ONE.
1092:         MOVE AC3,GCINFO(AC2)    ;GIVE NEW BLK. SAME GC CODE AS
1093:         MOVEM AC3,GCINFO(AC1)   ; OLD ONE.
1094:         MOVNI AC3,INITWC        ;SET UP NO. OF FREE WORDS IN NEW BLOCK.
1095:         MOVEM AC3,WCNT(DAT)
1096:         MOVE AC3,INITWC(AC2)    ;PICK UP RETURN JMP FROM END OF OLD BLK..
1097:         MOVEM AC3,(AC1)         ;.. AND PUT IN FIRST WORD OF NEW ONE.
1098:         HRRM AC1,LINK(AC2)      ;MAKE FORWARD LINK OF OLD ONE POINT AT NEW ONE.
1099:         HRLM AC1,INITWC(AC2)    ;MAKE JMP AT END OF OLD ONE POINT AT NEW ONE.
1100:         HRLZM AC2,LINK(AC1)     ;BACKWARD LINK OF NEW ONE TO OLD ONE...
1101:         SOJA AC1,L2             ;JIGGLE NEW BYTE PTR. A BIT AND PROCEDE.
1102: 
1103: BEND EXTBUF.
    DPYSER page# 0023 next  prev
1105: ; WE GET HERE UPON GLITCHING ON A DATA DISC DISPLAY
1106: ; IN THIS CASE, WE SEE IF THERE ARE ANY BLOCKS ABOVE THE
1107: ; CURRENT SCREEN. IF SO, WE CAN FREE THEM UP.
1108: 
1109: GLITCH: SOS GLHCNT(DDB)         ; BUMP COUNT OF GLITCHES TO GO UNTIL HOLD
1110:         MOVN AC3,DEL(DAT)       ; MOVE POINTERS DOWN BY THIS AMOUNT
1111:         SETOM GLTCH(DAT)        ; MARK THE FACT THAT WE HAVE GLITCHED
1112:         SETOM PPINV(DAT)        ; NOTE THAT POINTERS ARE BEING CHANGED
1113:         ADDM AC3,VPOS(DAT)      ; UPDATE VERTICAL POSITION BY NUMBER OF LINES IN GLITCH
1114:         PUSHJ P,PTMOVE          ; MAGIC CIRCULAR ROUTINE
1115:         SETZM PPINV(DAT)        ; POINTERS ARE OK NOW
1116: GLTCH3: PUSHJ P,POSLIN          ; PICK UP LINE NUMBER OF TOP OF PAGE
1117:         CAMLE AC3,VPOS(DAT)     ; IS THERE ANYTHING ON THE SCREEN AT ALL?
1118:         MOVE AC3,VPOS(DAT)      ; NOT YET, USE LAST POSITION WRITTEN IN
1119:         PUSHJ P,GLNADR          ; GET ADDRESS OF TEXT
1120:         HRRZ AC1,TBLKPT(DAT)    ; PICK UP THE POINTER TO THE CURRENT FIRST PAGE
1121:         HRRZI AC3,BLKSIZ-1(AC1) ; GET ADDRESS OF END OF THAT BLOCK
1122:         CAIL AC2,(AC1)          ; NOW, ARE WE INSIDE THAT FIRST BLOCK?
1123:         CAILE AC2,(AC3)
1124:         JRST GLTCH4             ; NO, FREE UP SOME BLOCKS
1125:         ADDI AC2,1              ; MAKE POINTER TO TOP OF PAGE
1126:         HRLM AC2,TPJMP(DAT)     ; POINT JUMP TO THERE
1127: PR1EL4: SOS AC1,GLCNT(DAT)      ;IS IT SMALL ENOUGH NOW ?
1128: ADJSIZ: CAMLE AC1,PGSIZ(DAT)
1129:         JRST GLITCH             ;NO. GLITCH IT SOME MORE.
1130:         POPJ P,
1131: 
1132: CNTWRP: MOVEI AC3,CNT           ;WRAP A POINTER AROUND THE GLITCH TABLE.
1133:         MOVEM AC3,@-2(AC2)
1134:         JRST (AC2)
1135: 
1136: GLTCH4: PUSHJ P,PR1FRE          ; GO FREE UP AT LEAST ONE
1137:         JRST GLTCH3             ; SEE IF WE CAN DO SOME MORE
    DPYSER page# 0024 next  prev
1139: ; THESE ARE UTILITY ROUTINES USED BY THE PAGE PRINTER
1140: ; THIS FIRST ROUTINE IS CALLED AT THE END OF THE LINE THAT
1141: ; GOES OFF THE SCREEN ON DATA DISK. WE REPACK THE WORD
1142: ; SUCH THAT THE POINTER POINTS TO THE NEXT WORD. THIS WAY
1143: ; THE I-LEVEL ROUTINES CAN REPLACE THE ENTIRE WORD WITH
1144: ; A JUMP INTO THE PAGE PRINTER CONTROL BLOCK TO KEEP IT
1145: ; FROM READING MORE TEXT WHICH WOULD BE OFF THE SCREEN.
1146: 
1147: EOLSET: MOVE AC1,PPTR1(DAT)     ; PICK UP POINTER TO LF
1148:         MOVEM AC1,SPTR1(DAT)    ; SAVE IT
1149:         SKIPGE DAT
1150:         SETZM TPJMP+1(DAT)      ; SINCE TEXT ENDS WITH A CRLF, NO EXECUTE IS NEEDED
1151:         LDB AC1,[POINT 6,PPTR1(DAT),5]
1152:         SUBI AC1,1              ; ARE THERE ANY SPACES LEFT IN THE WORD?
1153:         IDIVI AC1,7             ; THIS GETS NUMBER OF CHARACTERS LEFT IN AC1
1154:         JUMPE AC1,EOLSE3        ; IF NONE LEFT, GO ON.
1155:         PUSH P,AC1              ; PUT IN THAT MANY NULLS
1156:         SETZ CHR,
1157: EOLSE2: PUSHJ P,PUTCH1          ; FILL OUT WORD WITH NULLS.
1158:         SOSLE (P)               ; ENOUGH?
1159:         JRST EOLSE2             ; NO, GO DO ANOTHER ONE.
1160:         SUB P,[XWD 1,1]
1161: EOLSE3: MOVE AC3,VPOS(DAT)      ; WE ARE NOW ON THE NEXT LINE. BUMP VERTICAL POSITION COUNTER.
1162:         ADDI AC3,1              ; DON'T BUMP IN CORE UNTIL WE HAVE POINTER PLANTED
1163:         CAMLE AC3,GLW(DAT)      ; IS THIS FURTHER DOWN THAN THE PRESENT MAXIMUM LINE WRITTEN?
1164:         MOVEM AC3,GLW(DAT)      ; YES, BUMP NUMBER OF MAXIMUM LINE WRITTEN
1165:         PUSHJ P,GLNADR          ; PICK UP POINTER INTO LINE TABLE
1166:         MOVE AC2,PPTR1(DAT)     ; NOW PICK UP THE POINTER
1167:         MOVEM AC2,@PTRB(DAT)    ; PUT IT INTO LINE POINTER TABLE INDEXED BY LINE NUMBER
1168:         AOS VPOS(DAT)           ; NOW UPDATE VERTICAL POSITION
1169:         MOVEI CHR,12            ; FAKE UP SOMETHING FOR ERRP (AGGG!)
1170:         POPJ P,
    DPYSER page# 0025 next  prev
1172: ; HANDY ROUTINE TO GET POINTER TO TEXT FROM LINE NUMBER IN AC3
1173: ; RETURNS POINTER IN AC1.
1174: 
1175: GLNADR: ADD AC3,PTBEG(DAT)      ; ADD IN INCREMENT
1176: GLNAD2: CAMGE AC3,[-=20]        ; UNDERFLOW?
1177:         JRST GLNAD1             ; YES, BOOST IT
1178: GLNAD4: CAIL AC3,=60            ; OVERFLOW?
1179:         JRST GLNAD3             ; YES, BRING IT BACK INTO RANGE
1180:         HRRZ AC2,PTRB(DAT)      ; PICK UP POINTER
1181:         SUBI AC2,=20
1182:         CAME AC2,PTB(DAT)       ; IS IT WHAT IT IS SUPPOSED TO BE?
1183:         JRST GLNAD5             ; NO, ERROR
1184: GLNAD6: HRRZ AC2,@PTRB(DAT)     ; PICK UP POINTER
1185:         POPJ P,
1186: 
1187: GLNAD1: ADDI AC3,=80
1188:         JRST GLNAD2
1189: 
1190: GLNAD3: SUBI AC3,=80
1191:         JRST GLNAD4
    DPYSER page# 0026 next  prev
1193: ; WE GET HERE IF THE POINTERS DON'T AGREE
1194: 
1195: GLNAD5: PUSHACS
1196:         PUSHJ P,DISERR
1197:         [ASCIZ ⊗SOMEBODY CLOBBERED PTRB!!  - ⊗]
1198:         DISARG  OCT,<PTRB(DAT)>
1199:         [ASCIZ ⊗
1200: ⊗]
1201:         -1
1202:         POPACS
1203:         HRRZ AC2,PTB(DAT)       ; PICK UP THE (HOPEFULLY) CORRECT POINTER
1204:         CAML AC2,MEMSIZ
1205:         CAML AC2,RMEMSIZ
1206:         JRST GLNAD7
1207:         ADDI AC2,=20
1208:         HRLI AC2,AC3            ; SET TO INDEX BY AC3
1209:         MOVEM AC2,PTRB(DAT)
1210:         JRST GLNAD6
1211: 
1212: GLNAD7: HRRZ AC2,PTRB(DAT)
1213:         SUBI AC2,=20
1214:         CAML AC2,MEMSIZ
1215:         CAML AC2,RMEMSIZ
1216:         JRST HELPX
1217:         HRRZM AC2,PTB(DAT)
1218:         JRST GLNAD6
1219: 
1220: HELPX:  PUSHJ P,DISERR
1221:         [ASCIZ ⊗HELP! - CAN'T FIX IT
1222: ⊗]
1223:         -1
1224:         SETOM DISFLAG
1225:         PUSHJ P,DISFLUSH
1226:         JRST AUTOLOAD
    DPYSER page# 0027 next  prev
1228: ; ROUTINE TO CONVERT THE POSITION VECTOR INTO A DATA DISK
1229: ; LINE NUMBER. GOES FROM 1 TO 40.
1230: 
1231: POSLIN: LDB AC3,[POINT 11,PPOSV(DAT),21]
1232:         TRNE AC3,1⊗=10          ; EXTEND SIGN BIT
1233:         OR AC3,[-1⊗=10]         ; BY ORING IN BITS
1234:         SKIPN PPDD(DAT)         ; IS THIS A DATA DISC DISPLAY?
1235:         JRST POSLI1             ; NO, USE SEPARATE ROUTINE
1236: POSLI2: IMULI AC3,=20
1237:         ASH AC3,-=9             ; THIS GIVES A NUMBER FROM -=19 TO =20
1238:         MOVNS AC3               ; FOR DD, ASCENDING LINE NUMBERS GO DOWN THE SCREEN
1239:         ADDI AC3,=20            ; WE NOW HAVE A NUMBER FROM 1 TO =40 IN AC3
1240:         POPJ P,
1241: 
1242: POSLI1: IMULI AC3,=12           ; III ONLY HAS 24 LINES ON THE SCREEN
1243:         ASH AC3,-=9
1244:         MOVNS AC3
1245:         ADDI AC3,=12
1246:         POPJ P,
    DPYSER page# 0028 next  prev
1248: FBLK:   PUSH P,AC1              ;FREE SOME BLOCKS FROM P.P.
1249: FB1:    MOVE AC1,GLCNT(DAT)
1250:         SKIPLE BLKTOT(DDB)      ;DID WE FREE ENOUGH BLOCKS ?
1251:         CAIG AC1,1              ;LESS THAN 1 GLITCH ON SCREEN ?
1252:         JRST POPAJ              ;YES. RESTORE AC1 AND RETURN.
1253:         PUSHJ P,GLITCH          ;MOVE PAPER ONE GLITCH.
1254:         JRST FB1
1255: 
1256: PR1FRE: MOVE AC2,TBLKPT(DAT)    ;WE HAVE FINISHED WITH ANOTHER BLOCK. GET PTR. TO IT.
1257:         MOVEI AC1,TBLKBT        ;CODE BIT FOR GC MEANING `TOP BLK OF PAGE'
1258:         ANDCAM AC1,BLKBTS(AC2)  ;TURN IT OFF IN OLD TOP BLK.
1259:         HRRZ AC2,LINK(AC2)      ;GET FORWARD PTR. (TO NEW TOP BLK.)
1260:         CAML AC2,MEMSIZ
1261:         CAML AC2,RMEMSIZ
1262:         JRST PR1ERR             ; GROSS ERROR!
1263: PR1ER2: MOVEM AC2,TBLKPT(DAT)
1264:         IORM AC1,BLKBTS(AC2)
1265:         SOSG OUTCNT(DAT)        ;HAVE WE ENOUGH UNUSED BLOCKS FOR A DISK OUTPUT ?
1266:         PUSHJ P,PPOUT           ;YES. GET RID OF THEM.
1267:         POPJ P,
1268: 
1269: PR1ER3: PUSHACS
1270:         PUSHJ   P,DISMES
1271:         ASCIZ   /FIND A WIZARD OR RELOAD
1272: /
1273:         PUSHJ   P,DISFLU
1274:         PUSHJ   P,DDTCALL
1275:         POPACS
1276:         HALT    AUTOLOAD
1277: 
1278: PR1ERR: HRRZ    AC3,PRGNUM(DDB)
1279:         PUSHACS
1280:         PUSH    P,AC3
1281:         PUSH    P,AC2
1282:         PUSHJ   P,DISMES
1283:         ASCIZ   /BAD POINTER AT PR1FRE: /
1284:         POP     P,TAC
1285:         PUSHJ   P,DISLOC
1286:         PUSHJ   P,DISMES
1287:         ASCIZ   /,  TTY = /
1288:         POP     P,TAC
1289:         PUSHJ   P,DISLOC
1290:         PUSHJ   P,DISCRLF
1291:         POPACS
1292:         MOVEI   AC1,=20*=40/INITWC
1293:         MOVE    AC3,CBLKPT(DAT)
1294: PR1ER1: MOVEI   AC2,(AC3)
1295:         HLRZ    AC3,LINK(AC3)
1296:         CAML    AC3,MEMSIZ
1297:         CAML    AC3,RMEMSIZ
1298:         JRST    PR1ER3
1299:         CAME    AC3,TBLKPT(DAT)
1300:         SOJG    AC1,PR1ER1
1301:         JUMPLE  AC1,PR1ER3
1302:         MOVE    AC3,TBLKPT(DAT)
1303:         HRLM    AC2,LINK(AC3)
1304:         MOVEI   AC1,TBLKBT
1305:         JRST    PR1ER2
    DPYSER page# 0029 next  prev
1307: PPOUT:  ;WE GET HERE WHEN IT IS TIME TO OUTPUT PART OF A PIECE OF PAPER TO THE DISK.
1308:         MOVEI AC3,OUTNUM        ;NO. OF BLOCKS TO PUT OUT.
1309:         MOVEM AC3,OUTCNT(DAT)   ;RESET IT.
1310:         MOVE AC1,FBLKPT(DAT)    ;POINTER TO  FIRST BLK IN CORE.
1311:         SKIPA AC2,AC1
1312:         HRRZ AC2,LINK(AC2)      ;GO TO NEXT BLOCK.
1313:         SOJG AC3,.-1            ;GO TO LAST BLOCK TO BE OUTPUT.
1314: ;;SINCE CROCKISH R. SAUNDERS HAS NO DISK CODE YET, WE JUST RETURN THE BLOCKS TO FREE STORAGE.
1315:         HRRZ AC3,LINK(AC2)      ;NEXT BLK.
1316:         HRRZM AC3,FBLKPT(DAT)   ;MAKE FBLKPT POINT TO NEW FIRST BLOCK IN CORE.
1317:         HRLM DAT,LINK(AC3)      ;MAINTAIN REV LINK
1318:         SETZM LINK(AC2)         ;ZERO LINK IN LAST BLOCK TO BE FREED.
1319: ↑SETRST:PUSHJ P,FREEL           ;FREE THE BLOCKS.
1320: ↑↑WHORST:
1321:         SKIPN III(DDB)          ;IS IT AN III?
1322:         POPJ P,                 ;NO.
1323: PPRST:  HRRZ AC3,PRGNUM(DDB)    ;GET PROGRAM NUMBER
1324:         MOVEI AC2,PSELB(DDB)    ;YES. INVENT A RESTARTING JMP FOR IT AND
1325:         HRLI AC2,DISJMP         ; PLACE IN RSTTBL SO PRGM WILL GET STARTED AT
1326:         MOVSM AC2,RSTTBL(AC3)   ;AT ITS BEGINNING NEXT TIME.
1327:         POPJ P,
    DPYSER page# 0030 next  prev
1329: ;A SIMPLE MESSAGE PRINTER. JSA ITEM,ERRP WITH
1330: ;BYTE PTR. TO TEXT FOLOWING THE JSA .
1331: 
1332: ↑ERRP2: HLRZ DAT,PPCALL(DDB)    ;GET P OF P 0.
1333:         HLL DAT,DDB             ; COPY OVER THE DD FLAG IF ANY
1334:         PUSHACS                 ; SAVE ALL OUR ARGUEMENTS
1335:         MOVE J,JOB(PID)
1336:         PUSHJ P,PPCLR           ; RESET THE PAGE PRINTER
1337:         MOVE J,-17+J(P)
1338:         MOVE TAC,(ITEM)         ;GET BYTE POINTER TO MESSAGE.
1339: ERRP3:  CONO PI,SCNOFF          ;TURN OFF RPH
1340:         PUSHJ P,TYOTAC          ;TYPE A CHAR.
1341:         CONO PI,SCNON           ;TURN ON RPH
1342:         JUMPN CHR,ERRP3         ;LOOP UNTIL FIRST NULL CHAR.
1343:         POPACS
1344:         JRA ITEM,1(ITEM)
    DPYSER page# 0031 next  prev
1346: ;;HERE ARE UUO LEVEL ROUTINES FOR MANIPULATING THE PAGE PRINTER.
1347: 
1348: ;;THESE ROUTINES ARE ENTERED WITH STANDARD UUO LEVEL
1349: ;; SETUP OF AC'S UUO AND ITEM, WITH
1350: ;; DDB (≡DEVDAT) POINTING TO DPY PROGRAM HEADER.
1351: 
1352: 
1353: ;;PPFIND FINDS PIECE OF PAPER INDICATED BY (UUO); CREATES IT IF NECESSARY.
1354: ;; RETURNS WITH DAT POINTING TO P. OF P. CONTROL BLOCK.
1355: 
1356: PPFND1: HLL DAT,DDB             ; PICK UP DD FLAG BIT
1357:         HLRZ AC2,PPCALL(DDB)    ;GET PTR. TO FIRST P. OF P.
1358:         HRRZ TAC,UUO            ;NO. OF PIECE WE ARE LOOKING FOR.
1359:         CAIL TAC,20             ;BETTER NOT BE TOO HIGH.
1360:         JRST PPFER              ;LOSE, LOSE.
1361: PFL2:   HRRM AC2,DAT            ;LOOK AT NEXT P. OF PAPER.
1362:         CAMN TAC,PPNO(DAT)      ;IS IT THE ONE WE WANT ?
1363:         POPJ P,                 ;YES.
1364:         HRRZ AC2,LINK(DAT)      ;GET LINK TO NEXT ONE.
1365:         JUMPN AC2,PFL2          ;LOOP IF THERE IS A NEXT ONE.
1366:         POPJ P,
1367: 
1368: PPFND:  PUSHJ P,PPFND1          ;FIND INDICATED P OF P.
1369:         JUMPN AC2,CPOPJ         ;RETURN IF IT EXISTS.
1370:         PUSH P,DAT              ; SAVE POINTER TO LAST PROGRAM HEADER
1371:         PUSH P,TAC              ; SAVE NUMBER OF DESIRED PIECE OF PAPER
1372:         HLRE TAC,PRGNUM(DDB)    ; PICK UP DPY NUMBER FOR PPINIT
1373:         PUSHJ P,PPINIT          ;IT DOESN'T. MAKE A NEW PIECE APPEAR.
1374:         JSP UUO,DWPERR          ; NOT THERE, GHASTLY ERROR
1375:         POP P,PPNO(AC1)         ;MAKE IT HAVE RIGHT NO.
1376:         POP P,DAT               ; GET BACK POINTER TO LAST PIECE OF PAPER
1377:         HRRM AC1,LINK(DAT)      ;LINK IT TO OTHER PIECES.
1378:         HRLZM DAT,LINK(AC1)     ;PUT IN ITS BACKWARD LINK.
1379:         HRRZM DDB,HEDPTR(AC1)   ;GIVE IT PTR. TO PRGM. HEAD.
1380:         MOVE AC3,PPRJMP(DAT)    ;GET LINKING (I. E. RETURN) JMP FROM LAST P OF P...
1381:         MOVEM AC3,PPRJMP(AC1)   ;GIVE IT TO NEW PIECE...
1382:         HRLM AC1,PPRJMP(DAT)    ;.. AND MAKE LAST PIECE CALL NEW ONE.
1383:         MOVEM AC1,DAT
1384:         HLL DAT,DDB             ; PUT IN TYPE BITS
1385:         POPJ P,
1386: 
1387: PPFER:  ;PRINT H. S. MESSAGE.
1388:         ERMS {ILLEGAL PIECE OF PAPER}
1389:         JRST UUOERR             ;NOW GIVE STANDARD JUNK AND STOP JOB.
    DPYSER page# 0032 next  prev
1391: ;;MORE PP ROUTINES.
1392: 
1393: 
1394: PPSEL1: PUSHJ P,PPFND           ;LOCATE P. OF P. INDICATED BY UUO.
1395:         HRRZM DAT,CURPP(DDB)    ;MAKE IT THE CURRENT ONE.
1396:         MOVEI UUO,400000        ;PREPARE TO ACTIVATE IT,
1397:         MOVN TAC,PPNO(DAT)      ; BY GENERATING PARAM. FOR
1398:         LSH UUO,(TAC)           ;CALL ON PPACT.
1399:         POPJ P,
1400: 
1401: PPREL:  TRNN UUO,-1             ;FLUSH PP WHOSE NUMBER IS IN UUO (RIGHT)
1402:         POPJ P,                 ;BUT NOT IF IT'S PP ZERO
1403:         PUSHJ P,PPFND1          ;FIND P OF P
1404:         JUMPE AC2,CPOPJ         ;SAVE SOME TIME IF THERE IS NONE
1405:         PUSH P,DDB
1406:         PUSHJ P,PPWAIT          ; WAIT FOR ANY TYPEOUT TO FINISH BEFORE FLUSHING PAGE
1407:         POP P,DDB
1408:         PUSHJ P,PPFND1          ;NOW SEE IF P OF P IS STILL THERE
1409:         JUMPE AC2,CPOPJ         ;RETURN IF NOT.
1410:         MOVE AC1,LINK(DAT)      ;SIGH.  GET FWD AND BWD LINKS FROM CTRL. BLK.
1411:         TRNE AC1,-1             ;UNLESS CTRL. BLK IS LAST ONE,
1412:         HLLM AC1,LINK(AC1)      ;..UPDATE BWD LINK OF NEXT ONE.
1413:         MOVSS AC1
1414:         HLRM AC1,LINK(AC1)      ;NOW FWD LINK OF PREVIOUS ONE (AREN'T LINKED LISTS FUN ?)
1415:         MOVE AC3,PPRJMP(DAT)    ;TAKE LINKING JMP FROM THIS BLK...
1416:         MOVEM AC3,PPRJMP(AC1)   ;..AND GIVE IT TO PREVIOUS ONE.
1417:         JUMPG DAT,PPREL3        ; DON'T ERASE IF III, WILL BE DONE AUTOMATICALLY
1418:         PUSHJ P,POSLIN          ; GET FIRST LINE NUMBER OF PAGE
1419:         PUSH P,AC3
1420:         PUSH P,GLW(DAT)         ; ERASE ALL THE WAY TO THE LAST LINE
1421:         SOS (P)
1422:         PUSHJ P,PPERS
1423:         SUB P,[XWD 2,2]         ; NORMALIZE THE STACK
1424: PPREL3: MOVEM   DDB,LINK(DAT)   ;SINCE WE ARE LINKED OUT, WE CAN USE THIS TO
1425:                                 ;SAVE DDB IN CASE OF A CLOCK CALL LATER
1426: PPREL4: MOVE    DDB,LINK(DAT)   ;MAKE SURE DDB IS SET UP
1427:         SKIPN   PPENQ(DAT)      ;ANYTHING HAPPENING HERE?
1428:         SKIPE   PPNQT(DAT)
1429:         JRST    CLKREL          ;YES, DON'T RELEASE IT UNTIL IT IS DONE
1430:         MOVE    AC1,DAT         ;NOW FREE THE CTRL BLK.
1431:         PUSHJ   P,CGIVFS
1432:         MOVE    AC1,FBLKPT(DAT) ;ALSO FREE THE PROGRAM BLOCKS.
1433:         PUSHJ   P,FREEL
1434:         HRRZ    AC1,PTB(DAT)    ;GIVE BACK TABLE OF END OF LINE POINTERS
1435:         PUSHJ   P,FSGIVE
1436: PPREL2: HRRZ AC1,DAT
1437:         CAME AC1,CURPP(DDB)     ;HAVE WE JUST DELETED SELECTED P OF P ?
1438:                                 ;USED TO BE CAMN DCS/RPH
1439:         POPJ P,
1440:         MOVEI UUO,0             ;YES. SELECT PP 0.
1441:         JRST PPSELN
1442: 
1443: CLKREL: HRLI    DAT,PPREL4
1444:         JRST    DPYTIM
    DPYSER page# 0033 next  prev
1446: ;;PPSEL <N>  MAKES P. OF P. <N> THE CURRENT ONE AND TURNS IT ON.
1447: 
1448: PPSEL:  PUSHJ P,PPWAIT          ; WAIT FOR TYPEOUT TO FINISH
1449:         PUSHJ P,PRGFND
1450:         POPJ P,                 ; NO DPY HERE, JUST IGNORE
1451: PPSELN: PUSHJ P,PPSEL1          ;FIND IT, SELECT IT AND FALL INTO PPACT.
1452: 
1453: ;;PPACT X TURNS P OF P'S ON AND OFF ACCORDING TO BITS IN X;
1454: ;;  BIT N+18 CORRESPONDS TO P. OF P. N.
1455: 
1456: PPACT:  MOVEI AC1,DISJMP        ;JMP OPCODE FOR DPY.
1457:         MOVEI AC2,DISNOP
1458:         HLRZ AC3,PPCALL(DDB)    ;GET FIRST P OF P.
1459: PACTL1: MOVE TAC,UUO            ;MAKE COPY OF THE X BITS.
1460:         ROT TAC,@PPNO(AC3)      ;GET BIT FOR THIS P OF P INTO 18.
1461:         HRRM AC2,TPJMP(AC3)     ;ASSUME BIT IS OFF.
1462:         TRNE TAC,400000         ;IS IT ?
1463:         HRRM AC1,TPJMP(AC3)     ;NO. ACTIVATE THE P OF P.
1464:         MOVE TAC1,PRGACT(DDB)   ; PICK UP CURRENT ACTIVATION BITS
1465:         ROT TAC1,@PPNO(AC3)     ; PUT BIT FOR THIS DISPLAY IN B18
1466:         XOR TAC1,TAC            ; ARE THEY DIFFERENT?
1467:         TRNE TAC1,400000
1468:         JRST PACTL2             ; YES, MARK IT AS VIRGIN IF APPEARING, ERASE IF DISSAPEARING
1469: PACTL3: HRRZ AC3,LINK(AC3)      ;GET NEXT P OF P HEADER.
1470:         JUMPN AC3,PACTL1        ;LOOP IF THERE IS ONE.
1471:         HRRM UUO,PRGACT(DDB)    ;ALL DONE. RECORD NEW STATE OF ACTIVATION.
1472:         POPJ P,
1473: 
1474: PACTL2: TRNN TAC,400000         ; NOW, ARE WE APPEARING OR DISSAPEARING?
1475:         JRST PACTL4             ; DISSAPEARING, GO ERASE SCREEN
1476:         SETOM PPVIRG(AC3)       ; APPEARING, NOTE A VIRGIN SCREEN
1477:         JRST PACTL3
1478: 
1479: PACTL4: SKIPE PPVIRG(AC3)       ; IS THERE ANYTHING THERE?
1480:         JRST PACTL3             ; NO, NOTHING TO ERASE
1481:         PUSH P,DAT              ; SAVE PAGE PRINTER CONTROL BLOCK ADDRESS
1482:         MOVE DAT,AC3            ; MAKE US THE ONE
1483:         PUSHJ P,POSLIN          ; GET BOUNDS OF PAGE IN LINE NUMBERS
1484:         PUSH P,AC3              ; THAT IS FIRST LINE
1485:         PUSH P,GLW(DAT)         ; CURRENT LINE IS LAST LINE
1486:         SOS (P)
1487:         PUSHJ P,PPERS           ; CAUSE ERASURE TO HAPPEN
1488:         SUB P,[XWD 2,2]
1489:         MOVE AC3,DAT            ; PUT PAGE PRINTER CONTROL BLOCK ADDRESS BACK
1490:         POP P,DAT
1491:         MOVEI AC1,DISJMP
1492:         MOVEI AC2,DISNOP
1493:         JRST PACTL3
    DPYSER page# 0034 next  prev
1495: ; ROUTINE TO WAIT FOR TYPEOUT TO FINISH
1496: 
1497: PPWAIT: CONSZ PI,77400          ; CAN'T DO THIS AT INTERRUPT LEVEL
1498:         POPJ P,
1499:         MOVE ITEM,JOB
1500:         MOVE DDB,JBTLIN(ITEM)   ;FIND GUY'S TTY.
1501:         CAME DDB,[-1]           ; IS HE DETATCHED?
1502:         SKIPN DDB,TTYTAB(DDB)   ; GET TTY DDB, DOES HE EXIST?
1503:         POPJ P,                 ; HMM. WELL, BE THAT WAY!
1504:         MOVE TAC,DEVIOS(DDB)
1505:         TLNN TAC,TOIP
1506:         POPJ P,
1507:         PUSHJ P,DDTWAT          ; WAIT FOR THE TYPEOUT TO TERMINATE
1508:         MOVE ITEM,JOB(PID)
1509:         POPJ P,
    DPYSER page# 0035 next  prev
1511: ;;PPYPOS Y MAKES THE CURRENT P OF P START AT Y COORD. Y.
1512: 
1513: PPYPOS: SETZ AC1,
1514:         DPB AC1,POSSBU          ; NOTE Y-POSITION SE BY UUO
1515:         PUSHJ P,POSLIN          ; GET LINE NUMBER OF CURRENT LINE
1516:         PUSH P,AC3              ; AND PUSH IT
1517:         PUSH P,GLW(DAT)         ; SAVE BOTTOM OF PAGE
1518: PPYPO1: SETOM PPINV(DAT)        ; NOTE POINTERS ARE BEING CHANGED
1519:         DPB UUO,[POINT 11,PPOSV(DAT),21]        ;PUT NEW Y COORD. INTO POSITION VECTOR
1520:         PUSHJ P,POSLIN          ; NOW PICK UP POSITION COLUMN
1521:         MOVE AC1,AC3
1522:         MOVE AC2,AC3
1523:         MOVN AC3,-1(P)
1524:         ADD AC3,AC1             ; UPDATE VERTICLE POSITION
1525:         JUMPE AC3,PPYPO3        ; IF NO DIFFERENCE, WE DON'T HAVE TO MOVE LINE POINTER TABLE
1526:         MOVEM AC2,LLW(DAT)      ; MAKE SURE WE START AT THE LOGICAL TOP OF PAGE
1527:         PUSHJ P,PTMOVE          ; MOVE POINTERS
1528:         ADDM AC3,VPOS(DAT)
1529:         SETZM PPINV(DAT)        ; NOTE POINTERS ARE VALID NOW
1530:         JUMPGE DAT,PPYPO3       ; IF III, LEAVE NOW
1531:         JUMPN AC3,PPYPO2        ; IF WE ARE MOVING DOWN, WE HAVE TO ERASE EXPLICITLY
1532: PPYPO4: SUB P,[XWD 2,2]         ; OTHERWISE, WE CAN PRETEND WE ARE GLITCHING AND
1533: REFPAG: JUMPGE DAT,CPOPJ        ; LEAVE IF III
1534:         PUSH P,DAT              ; SAVE THE POINTER TO THE PAGE PRINTER CONTROL BLOCK
1535:         HRRZ DAT,HEDPTR(DAT)    ; PUT DPY PROGRAM HEADER ADDRESS IN DAT
1536:         PUSHJ P,LERFP           ; GET IT DONE AUTOMATICALLY.
1537:         POP P,DAT               ; GET BACK OUR PAGE PRINTER CONTROL BLOCK ADD
1538:         POPJ P,
1539: 
1540: PPYPO3: SUB P,[XWD 2,2]         ; RESTORE THE STACK
1541:         SETZM PPINV(DAT)        ; POINTERS ARE OK NOW
1542:         POPJ P,
    DPYSER page# 0036 next  prev
1544: ; WE GET HERE WHEN THE APPEARANCE OF THE PAGE HAS CHANGED ENOUGH
1545: ; SO THAT THE PAGE HAS TO BE REFRESHED.
1546: 
1547: PPYPO2: ADDM AC3,GLW(DAT)       ; UPDATE THE NUMBER OF THE LAST LINE WRITTEN
1548:         HRRZ AC1,TPJMP(DAT)     ; PICK UP JUMP TO TEXT
1549:         SKIPN PPVIRG(DAT)       ; DON'T ERASE A VIRGIN SCREEN!
1550:         CAIN AC1,DISNOP         ; IS IT REALLY A JUMP?
1551:         JRST PPYPO4             ; NO, DON'T WRITE ON IT
1552:         MOVE AC2,(P)            ; PICK UP FINISHING LINE OF TRANSFER
1553:         SUB AC2,-1(P)           ; GET LENGTH OF PAGE
1554:         MOVM AC1,AC3            ; GET MAGNITUDE OF TRAVEL
1555:         CAML AC1,AC2
1556:         JRST PPYPO5             ; IF TRAVEL LARGER THAN PAGE, ERASE ENTIRE PAGE
1557:         SUB AC2,AC1             ; OTHERWISE, ERASE ONLY NON-OVERLAPPED PART
1558:         MOVN AC1,AC2
1559:         SKIPG AC3               ; IF GOING UP,
1560:         JRST PPYPDN             ; THEN ERASE FROM THE MIDDLE DOWN TO THE BOTTOM
1561:         ADDM AC1,(P)
1562:         SOS (P)
1563: PPYPO5: PUSHJ P,PPERS
1564:         JRST PPYPO4
1565: 
1566: PPYPDN: ADDM AC2,-1(P)
1567:         JRST PPYPO5
    DPYSER page# 0037 next  prev
1569: ; ROUTINE TO ERASE PARTS OF DATA DISK SCREEN
1570: ; CALL WITH STARTING LINE OF ERASURE AT -2(P)
1571: ; ENDING LINE AT -1(P)
1572: 
1573: PPERS:  PUSHJ P,GETQ            ; GET A TASK BLOCK
1574:         PUSH P,AC1              ; SAVE ITS ADDRESS
1575:         PUSHJ P,GETQ            ; GET ANOTHER ONE
1576:         POP P,TAC               ; GET BACK THE ADDRESS OF THE FIRST ONE
1577:         MOVE AC2,-2(P)          ; PICK UP STARTING LINE OF TRANSFER
1578:         MOVE AC3,-1(P)          ; AND ENDING LINE OF TRANSFER
1579:         CAMGE AC3,AC2           ; IF THE FINISHING LINE IS ABOVE THE STARTING LINE . . .
1580:         MOVE AC3,AC2            ; THEN ONLY ERASE ONE LINE
1581:         HRLM AC2,QLINE(AC1)     ; MAKE THIS THE STARTING LINE NUMBER OF THE ERASURE
1582:         HRLM AC2,QLINE(TAC)
1583:         HRRM AC3,QLINE(AC1)
1584:         HRRM AC3,QLINE(TAC)
1585:         HRLM DAT,(AC1)          ; PUT IN PAGE PRINTER CONTROL BLOCK ADDRESS
1586:         HRLM DAT,(TAC)
1587:         MOVEI AC2,ERASE         ; CALL THE ERASE CODE
1588:         HRRM AC2,(AC1)
1589:         HRRM AC2,(TAC)
1590:         SETZM QFIELD(TAC)       ; MAKE THE FIRST TASK GO OUT ON THE FIRST FIELD
1591:         SETOM QFIELD(AC1)       ; AND THE SECOND TASK GO OUT ON THE SECOND FIELD
1592:         SETZM QCOUNT(TAC)       ; NOTE THAT WE DON'T CARE TO BE AWAKENED
1593:         SETZM QCOUNT(AC1)
1594:         PUSH P,TAC              ; SAVE THE ADDRESS OF ONE OF THE BLOCKS
1595:         PUSHJ P,QBLOCK          ; QUEUE THE BLOCK
1596:         POP P,AC1               ; GET BACK THE ADDRESS OF THE OTHER
1597:         JRST QBLOCK             ; QUEUE IT UP TOO
    DPYSER page# 0038 next  prev
1599: ; HERE IS A ROUTINE TO MOVE THE LINE POINTER TABLE AROUND
1600: ; IN A CIRCULAR FASHION, SO AS NOT TO LOSE ANY POINTERS.
1601: ; CALL WITH NUMBER OF LINES TO BE MOVED IN AC3. NEGATIVE
1602: ; MEANS SCREEN IS MOVING UP, POSITIVE MEANS IT IS MOVING DOWN.
1603: ; NUMBER IS ASSUMED TO BE -=79 TO =79
1604: 
1605: PTMOVE: PUSH P,AC3              ; SAVE COUNT
1606:         MOVNS AC3
1607:         ADD AC3,PTBEG(DAT)      ; ADD IN TO CURRENT INCREMENT
1608: PTMOV2: CAIL AC3,=80            ; IS THE INCREMENT OUT OF RANGE?
1609:         JRST PTMOV1             ; YES, BRING IT BACK IN
1610: PTMOV4: SKIPGE AC3              ; SAME FOR NEGATIVE
1611:         JRST PTMOV3
1612:         MOVEM AC3,PTBEG(DAT)
1613:         POP P,AC3
1614:         POPJ P,
1615: 
1616: PTMOV1: SUBI AC3,=80
1617:         JRST PTMOV2
1618: 
1619: PTMOV3: ADDI AC3,=80
1620:         JRST PTMOV4
    DPYSER page# 0039 next  prev
1622: ;;PPXSIZ <N>B26 ! <M>  SETS CURRENT P OF P TO HAVE N GLITCHES OF M LINES.
1623: 
1624: PPXSIZ: 
1625:         SETZ AC1,
1626:         DPB AC1,SIZSBU          ; NOTE THAT PAGE SIZE SET BY UUO
1627:         MOVE AC1,GLCNT(DAT)     ; PICK UP NUMBER OF GLITCHES SO FAR ON THIS PAGE
1628:         IMUL AC1,DEL(DAT)       ; MULTIPLY BY NUMBER OF LINES IN PER GLITCH
1629:         SUB AC1,DELCNT(DAT)     ; ADD IN NUMBER OF LINES SO FAR IN LAST GLITCH
1630:         PUSH P,AC1              ; AND SAVE THIS
1631:         LDB AC1,[POINT 9,UUO,26]        ;NO. OF GLITCHES REQUESTED.
1632:         LDB AC2,[POINT 9,UUO,35]        ;NO. OF LINES/GLITCH.
1633:         IMUL AC2,AC1            ;TOTAL SIZE OF REQUESTED PAGE, IN LINES.
1634:         CAIG AC2,1              ; MUST END UP 2 OR MORE LINES LONG
1635:         JRST PPX1
1636:         MOVEI AC3,=40           ; DATA DISK TAKES 40 LINES
1637:         CAIG AC2,(AC3)          ;MORE THAN 25 LINES ?
1638:         CAILE AC1,CNT           ;TOO MANY GLITCHES ?
1639:         JRST PPXERR             ;YES. LOSE.
1640: PPX2:   MOVEM AC1,PGSIZ(DAT)    ;UPDATE GLITCHES/PAGE.
1641:         DPB UUO,[POINT 9,DEL(DAT),35]   ;UPDATE GLITCH SIZE.
1642:         POP P,AC1               ; GET NUMBER OF LINES ON PAGE
1643:         IDIV AC1,DEL(DAT)       ; SEE HOW MANY NEW GLITCHES THAT MAKES
1644:         MOVEM AC1,GLCNT(DAT)    ; THIS IS OUR NEW GLITCH COUNT
1645:         AOS GLCNT(DAT)          ; MAKE IT GO FROM 1 TO PGSIZ
1646:         SUB AC2,DEL(DAT)        ; MAKE INTO NUMBER OF LINES TO GO
1647:         MOVNM AC2,DELCNT(DAT)   ; SET NUMBER OF LINES TO GO IN CURRENT GLITCH
1648:         MOVE AC1,GLCNT(DAT)     ; PICK UP NUMBER OF GLITCHES ON THIS PAGE
1649:         PUSHJ P,ADJSIZ          ;.. AND GO ADJUST TO NEW SIZE.
1650:         JRST REFPAG             ; REFRESH NEW PAGE
1651: 
1652: PPXERR: CONSZ PI,77400
1653:         JRST POPAJ
1654:         ERMS {ILLEGAL PAGE SIZE SPEC.}
1655:         JRST UUOERR
1656: 
1657: PPX1:   MOVEI UUO,2             ; GIVE HIM A MINIMUM SIZE PAGE
1658:         MOVEI AC1,1
1659:         JRST PPX2
    DPYSER page# 0040 next  prev
1661: ;;CLKSER        ;THIS IS DPYSER'S OWN PRIVATE CLOCK QUEUER.
1662: 
1663: ↑DPYCLK:  ;HERE FROM CLKSER EVERY TICK.
1664:         HGMAC(35)
1665:         SKIPE AC1,FSWTHD        ;ANYTHING IN THE FREE STG. WAIT LIST ?
1666:         PUSHJ P,FREE            ;YES. GO PUT IT ON FREE STG. LIST.
1667:         CONO PI,PIOFF           ;...PEOPLE MAY USE FSWT2H AT INT. LEVEL...
1668:         MOVE AC1,FSWT2H         ;MOVE THINGS UP FROM THE SECOND-LEVEL WAIT LIST.
1669:         MOVEM AC1,FSWTHD
1670:         SETZM FSWT2H
1671:         CONO PI,PION
1672:         MOVE AC1,FSW2C
1673:         MOVEM AC1,FSWC
1674:         SETZM FSW2C
1675:         HGMAC(36)
1676:         SKIPLE WHOPTR           ; IF NEW WHO JUST UPDATED, SEND IT OUT NOW
1677:         PUSHJ P,WHOQUE          ; YES, QUEUE UP A REQUEST
1678:         HGMAC(37)
1679:         EXCH P,DPYPDL           ;YES. GET OUR OWN PDL.
1680:         SETOM CLKLVL            ;FLAG THAT WE ARE AT CLOCK LEVEL.
1681:         AOSN WTFLG              ;ARE WE IN A WAIT ?
1682:         POPJ P,                 ;YES. RETURN TO THE WAITING ROUTINE.
1683:         SKIPN @CLKQ             ;ANY REQUESTS IN THE CLK QUEUE ?
1684:         JRST CLKRTN             ;NO. SEE HOW LITTLE TIME WE HAVE WASTED !!
1685:         HRRZ TAC,CLKQ           ;GET PTR. TO CURRENT END OF QUEUE.
1686:         MOVEM TAC,CLKQTMP       ;SAVE IT.
1687: CLKL1:  CONO PI,PIOFF           ;NO INTERRUPTS, PLEASE.
1688:         MOVE DAT,@CLKQ          ;GET LAST REQUEST FROM QUEUE.
1689:         SOS CLKQ                ;MOVE POINTER BACK BY 1.
1690:         EXCH DAT,(TAC)          ;PICK UP THE REQUEST WE ARE SERVICING..
1691:         CONO PI,PION            ;(DIDN'T SEE A THING, DID YOU ?)
1692:         HLRZ TAC,DAT
1693:         PUSHJ P,(TAC)           ;..AND SERVICE IT, ALREADY.
1694:         HGMAC(37)               ;IN CASE SERVICE ROUTINE CHANGED HGCODE
1695:         SOS TAC,CLKQTMP         ;NOW GET PTR. TO NEXT LOWER ONE..
1696:         CAIL TAC,CLKQUE         ;ARE WE AT BOTTOM OF QUEUE ?
1697:         JRST CLKL1              ;NO. BACK FOR MORE.
1698: CLKRTN: EXCH P,DPYPDL           ;PUT BACK THE RIGHT PDL.
1699:         SETZM CLKLVL            ;NO LONGER IN CLOCK LEVEL CODE.
1700:         POPJ P,
    DPYSER page# 0041 next  prev
1702: ; THIS ROUTINE QUEUES UP ANOTHER WHO LINE REQUEST.
1703: ; ONLY ONE LINE IS QUEUED UP EVERY 12. TIX OR SO.
1704: ; CALLED FROM DPYCLK WHEN WHOPTR>0
1705: 
1706: WHOQUE: MOVNI   AC3,2
1707:         EXCH    AC3,WHOPTR      ;PICK UP NUMBER OF WHO LINE JUST UPDATED
1708:                                 ;SET WHOPTR TO -2 TO AVOID RE-ENTERING HERE.
1709:                                 ;WHOWRT WILL AOS WHOPTR FOR EACH FIELD DONE.
1710:                                 ;WHOPTR=0 ALLOWS WHOSER TO MAKE A NEW WHO LINE
1711:         MOVEI DAT,0
1712:         CAIN    AC3,DDAVLU      ; AVLCHN FLAG
1713:         JRST    WHOQ2
1714:         SKIPE   DAT,FRETAB(AC3) ; PICK UP ADDRESS OF WHO DATA
1715:         SKIPN   AC2,LETAB(AC3)  ; PICK UP ADDRESS OF DPY PROGRAM HEADER
1716:         JRST    WHOQ1           ; LEAVE IF NONE THERE
1717:         MOVE    AC2,CURPP(AC2)  ; GET ADDRESS OF PAGE PRINTER CONTROL BLOCK
1718:         MOVE    AC2,DDCW(AC2)   ; PICK UP COMMAND WORD
1719:         SKIPN   DAT,FRETAB(AC3) ; PICK UP ADDRESS OF WHO LINE
1720:         JRST    WHOQ1           ; LEAVE IF NONE THERE
1721:         MOVEM   AC2,(DAT)       ; PLACE IT IN THE WHO CODE
1722: WHOQ2:  PUSHJ   P,GETQ
1723:         MOVEM   AC3,QHPOS(AC1)  ; SAVE THE DPY NUMBER HERE
1724:         HRLI    DAT,WHOWRT
1725:         MOVSM   DAT,(AC1)
1726:         SETZM   QFIELD(AC1)     ;ON FIELD ZERO
1727:         MOVE    AC2,[XWD 1,2]   ;ON TOP TWO LINES
1728:         CAIN    AC3,DDAVLU
1729:         MOVE    AC2,AVLLN
1730:         MOVEM   AC2,QLINE(AC1)
1731:         SETZM   QCOUNT(AC1)
1732:         PUSH    P,AC3           ;SAVE THE DPY NUMBER
1733:         PUSHJ   P,QBLOCK        ;QUEUE UP THIS FIELD'S WORTH.
1734:         PUSHJ   P,GETQ
1735:         POP     P,QHPOS(AC1)    ;STORE THE DPY NUMBER
1736:         MOVSM   DAT,(AC1)
1737:         SETOM   QFIELD(AC1)     ;FIELD 1
1738:         MOVE    AC2,[XWD 1,2]
1739:         CAIN    AC3,DDAVLU
1740:         MOVE    AC2,AVLLN
1741:         MOVEM   AC2,QLINE(AC1)
1742:         SETZM   QCOUNT(AC1)
1743:         JRST    QBLOCK
1744: 
1745: WHOQ1:  SETZM   WHOPTR          ;HERE TO FLUSH THE WHO LINE REQUEST
1746:         POPJ    P,              ;WHOPTR MUST BE CLEARED.
    DPYSER page# 0042 next  prev
1748: ; ROUTINE TO FREE AN ENTIRE LIST OF BLOCKS, LINKED UP THROUGH LINK
1749: ; ENTER WITH TOP OF LIST IN TAC
1750: 
1751: FREE:   JUMPE AC1,CPOPJ
1752:         CAML AC1,MEMSIZ
1753:         CAML AC1,RMEMSIZ
1754:         POPJ P,
1755:         HRRZ TAC,LINK(AC1)      ;GET LINK BEFORE GIVING BACK FREE STORAGE
1756:         PUSHJ P,SFSGIV
1757:         DPYFS
1758:         MOVE AC1,TAC            ;LOOP FOR NEXT BLOCK
1759:         JRST FREE
1760: 
1761: GETFS:  PUSH P,AC1
1762:         PUSHJ P,UGETFS          ;GET A BLOCK OF FREE STG. (IN AC2).
1763:         MOVE AC2,AC1
1764: POPAJ:  POP P,AC1
1765:         POPJ P,
1766: 
1767: CLKWAT: CONSZ PI,77000
1768:         JRST ARRRGH
1769:         MOVEM 17,SVAC+17
1770:         MOVEI 17,SVAC           ;SAVE ALL AC'S.
1771:         BLT 17,SVAC+16
1772:         SETOM WTFLG             ;SET WAIT FLAG FOR CLK SERVICE.
1773:         PUSHJ P,CLKRTN          ;GO AWAY FOR A TICK.
1774:         MOVSI 17,SVAC           ;RESTORE THEM.
1775:         BLT 17,17
1776:         POPJ P,
1777: 
1778: ARRRGH: PUSHACS
1779:         PUSHJ P,DISDAT
1780:         PUSHJ P,DISMES
1781:         ASCIZ /AT CLKWAT IN CH5!!!!!
1782: /
1783:         PUSHJ P,DISFLU
1784:         SKIPN DEBMOD
1785:         JRST AUTOLO
1786:         POPACS
1787:         PUSHJ P,DDTCAL
1788:         JRST .-1        ;BETTER NOT RETURN WITH POPJ
    DPYSER page# 0043 next  prev
1790: ;;UUO LEVEL UTILITY ROUTINES AND DISPATCHERS.
1791: 
1792: ;;PRGFND  FINDS DPY PRGM FOR JOB IN ITEM.
1793: 
1794: PRGF2:  MOVE DDB,PTYJOB-PTYL0(DDB)      ;GET JOB WHICH OWNS PTY.
1795:         SKIPA DDB,JBTLIN(DDB)           ;USE HIS DPY, IF ANY.
1796: PRGF1:  MOVE DDB,JBTLIN(ITEM)           ;GET `TTY' LINE NO. FOR JOB., IF ANY.
1797:         TLNE DDB,PTYLIN                 ;IS GUY CONNECTED TO A PTY ?
1798:         JUMPG DDB,PRGF2                 ;YES, UNLESS HE IS DETACHED.
1799:         HRRZ AC1,DDB
1800:         AOJE DDB,CPOPJ1                 ;IF DETACHED (=-1) OR NOT A DPY (BIT 0 OFF), GIVE ERROR RETURN.
1801:         TLNN DDB,DISLIN!DDDLIN          ; IS THIS A DPY OF SOME SORT?
1802:         JRST CPOPJ1                     ; NO, ERROR
1803:         HRRZ DDB,LETAB-DPYL0-1(DDB)     ;GET PTR. TO PRGM HEADER.
1804: PRGF3:  HRRZ AC1,PRGNUM(DDB)            ; PICK UP DPY NUMBER
1805:         CAIL AC1,DPYNUM                 ; IS IT A DATA DISK DISPLAY?
1806:         TLO DDB,400000                  ; YES, MARK IT WITH THE SIGN BIT
1807:         POPJ P,
1808: 
1809: PRGFND: SKIPN DDB,DPYMAP(ITEM)  ;IS GUY CONNECTED TO SOMEONE ELSE'S DPY ?
1810:         PUSHJ P,PRGF1           ;NO. FIND ONE OF HIS OWN.
1811:         JRST CPOPJ1             ;SUCCESS RETURN
1812: PRGFER: CONSO PI,77400          ; WHAT LEVEL ARE WE?
1813:         POPJ P,                 ; IF AT UUO LEVEL, ERROR RETURN
1814:         CONSZ PI,400            ; IS IT CH7?
1815:         SKIPN SPWUUF(PID)       ; YES, ARE WE IN SPW MODE?
1816:         JRST PRGFE1             ; NO TO EITHER, GIVE ERROR MESSAGE
1817:         POPJ P,                 ; YES, SAME AS UUO LEVEL
1818: 
1819: PRGFE1: PUSHJ P,DISERR          ; OTHERWISE, ORDER-1 DISASTER
1820:         [ASCIZ ⊗ILLEGAL JOB NUMBER AT PRGFND NOT AT UUO LEVEL
1821: ⊗]
1822:         -1
1823:         JRST DPYATL
1824: 
1825: DDFND:  PUSHJ P,PRGFND          ; USE PRGFND
1826:         CAIA
1827:         JRST CPOPJ1
1828:         CAIE UCHN,3             ; DDFND CALLED ONLY FROM PGIOT WITH UCHN SETUP
1829:         POPJ P,                 ; ONLY THE DD UUO IS LEGAL
1830:         MOVEI AC3,DPYLEN
1831:         PUSHJ P,UFSGET
1832:         MOVE DDB,AC1
1833:         SETOM DPRLSF(DDB)
1834:         SETOM PRGNUM(DDB)
1835:         SETZM PRGCNT(DDB)       ; CAN'T BE ANY OVERLAP IN PROGRESS - RPH 10-5-72
1836:         TLO DDB,400000
1837:         JRST CPOPJ1             ; SUCCESS
    DPYSER page# 0044 next  prev
1839: ;;MORE GENERAL UUO ROUTINES.
1840: 
1841: ↑PPIOT: PUSHJ P,PRGFND          ;FIND APPROPRIATE DPY PRGM.
1842:         POPJ P,                 ;IGNORE IF NOT DISPLAY
1843:         MOVE DAT,CURPP(DDB)     ;GET PTR. TO CURRENT P OF P.
1844:         HLL DAT,DDB             ; PUT IN FLAG BIT
1845:         CAIG UCHN,MPPIOT        ;DOES FUNCTION EXIST ?
1846:         JRST @PPIOTX(UCHN)      ;YES.
1847:         JRST UUOERR
1848: 
1849: DEFINE UUOS{FOR X IN(PPSEL,PPACT,<DPYPOS,,PPYPOS>,<DPYSIZ,,PPXSIZ>
1850: ,PPREL,PPINFO,LEYPOS,PPHLD)}
1851: 
1852: UUOMAC PPIOTX,PPIOT
1853: MPPIOT←←UUOCNT-1
    DPYSER page# 0045 next  prev
1855: ; ROUTINE TO RESET A DISPLAY. CLEARS PAGE PRINTER AND PIECES OF GLASS.
1856: 
1857: ↑DPYCLR:JUMPN UCHN,DPYFOO       ;NON-ZERO AC FIELD MEANS SELECT OTHER DPY.
1858: ↑DPYRST:SETZM DPYMAP(ITEM)
1859:         PUSHJ P,PRGF1           ;FIND DPY PRGM FOR JOB IN ITEM.
1860:         SKIPA                   ;FOUND. WE WILL RESET IT TO INITIAL STATE.
1861:         POPJ P,                 ;NO PRGM.
1862:         PUSHJ P,PGCLR           ;FIRST FLUSH ALL PIECES OF GLASS.
1863: ↑PPCLR: MOVEI UUO,17            ;NOW ALL PIECES OF PAPER EXCEPT 0.
1864: 
1865: ; PPREL SELECTS P OF P 0 (UUO←0) IF IT RELEASES A P OF P
1866: ;   WHICH IS CURRENTLY SELECTED, AND NOT 0, SO.....
1867:         PUSH P,UUO              ;PPREL MAY CLOBBER UUO.
1868: PPC1:   PUSHJ P,PPREL           ;RELEASE P OF P.
1869:         SOSE UUO,(P)            ;NEXT
1870:         JRST PPC1               ;YES
1871:         SUB P,[XWD 1,1]         ;ADJUST STACK
1872:                                 ;ALL THIS TO HELP DCS. 5/27/70
1873:         HLL DAT,DDB             ; PUT IN FLAG BIT FOR DD
1874:         PUSH P,DDB              ; SAVE PROGRAM HEADER ADDRESS
1875:         PUSHJ P,PPSEL           ;SELECT P OF P 0.
1876: PPC2:   MOVE DDB,(P)            ; PICK UP PROGRAM HEADER
1877:         SETZ UUO,               ; CLEAR LINE EDITOR POSITION
1878:         PUSHJ P,LEYPOS
1879:         SETZ UUO,
1880:         PUSHJ P,PPHLD           ; RESET HOLDING STATUS
1881:         MOVEI UUO,YPIII         ;MAKE P OF P 0 START AT TOP OF SCREEN
1882:         SKIPGE DDB,(P)          ; PICK UP PROGRAM HEADER ADDRESS, SKIP IF NOT DATA DISC
1883:         MOVEI UUO,YPDD          ; DATA DISK STARTS ON THE THIRD LINE
1884:         PUSHJ P,PPYPOS
1885:         MOVEI UUO,NGSIII*1000+NLSIII            ;MAKE IT RIGHT SIZE.
1886:         POP P,DDB
1887:         JUMPGE DDB,PPXSIZ
1888:         MOVEI UUO,NGSDD*1000+NLSDD
1889:         PUSHJ P,PPXSIZ
1890:         HRRZ TAC,PRGNUM(DDB)
1891:         SUBI TAC,DPYNUM
1892:         PUSHJ P,VDRST1
1893:         JRST VDOUT
    DPYSER page# 0046 next  prev
1895: ; CALLED FROM <ESC>N IN LINE EDITOR BY A CLOCK REQUEST
1896: 
1897: ↑PPNSET:
1898:         PUSHJ P,SETPHD          ; SET UP DDB AND DAT PROPERLY
1899:         PUSH P,[PPNST1]
1900:         PUSH P,DDB
1901:         JRST PPC2
1902: 
1903: PPNST1: SETO AC1,               ; MARK SIZE AND Y-POSITION SET BY USER
1904:         DPB AC1,SIZSBU
1905:         DPB AC1,POSSBU
1906:         POPJ P,
1907: 
1908: SETPHD: HRRZ DDB,DAT            ; PUT PROGRAM HEADER ADDRESS IN DDB
1909:         SKIPN III(DDB)          ; SEE IF WE ARE A DATA DISK DISPLAY
1910:         TLO DDB,400000          ; IF SO, SET DATA DISK FLAG
1911:         MOVE DAT,CURPP(DDB)
1912:         HLL DAT,DDB
1913:         POPJ P,
1914: 
1915: ; CALLED FROM <ESC>G IN LINE EDITOR. SETS NUMBER OF GLITCHES
1916: 
1917: ↑PPGSET:
1918:         PUSHJ P,SETPHD
1919:         MOVEI AC3,NGSIII
1920:         SKIPG DAT
1921:         MOVEI AC3,NGSDD
1922:         SKIPN UUO,LEARG(DDB)    ; PICK UP NUMBER OF GLITCHES REQUESTED
1923:         MOVE UUO,AC3
1924:         LSH UUO,=9              ; PUT IN LH OF RH
1925:         ADD UUO,DEL(DAT)
1926: PPGST1: PUSHJ P,PPXSIZ          ; SET IT
1927:         SETO AC1,
1928:         DPB AC1,SIZSBU          ; NOTE SIZE WAS SET BY USER
1929:         POPJ P,
    DPYSER page# 0047 next  prev
1931: ; CALLED FROM <ESC>L IN LINE EDITOR. SETS LINES/GLITCH
1932: 
1933: ↑PPLSET:
1934:         PUSHJ P,SETPHD
1935:         MOVEI AC3,NLSIII
1936:         SKIPG DAT
1937:         MOVEI AC3,NLSDD
1938:         MOVE UUO,PGSIZ(DAT)
1939:         LSH UUO,=9
1940:         SKIPN AC2,LEARG(DDB)
1941:         MOVE AC2,AC3
1942:         ADD UUO,AC2
1943:         JRST PPGST1
1944: 
1945: ; CALLED FROM <ESC>Y IN LINE EDITOR. SETS Y POSITION
1946: 
1947: ↑PPYSET:
1948:         PUSHJ P,SETPHD
1949:         MOVEI AC3,YPIII
1950:         MOVE UUO,LEARG(DDB)
1951:         JUMPL DDB,PPYDD
1952:         MOVEI AC3,YPIII
1953:         IMUL UUO,[-30]
1954:         ADDI UUO,770+30
1955: PPYS2:  CAIL UUO,1000
1956:         MOVEI UUO,(AC3)         ;SET TO NORM ON ZERO (NULL) ARG
1957:         PUSHJ P,PPYPOS
1958:         SETO AC1,
1959:         DPB AC1,POSSBU
1960:         POPJ P,
1961: 
1962: PPYDD:  MOVEI AC3,YPDD
1963:         LSH UUO,7
1964:         IDIV UUO,[-5]
1965:         ADDI UUO,1000
1966:         JRST PPYS2
    DPYSER page# 0048 next  prev
1968: ; SET PAGE PRINTER HOLD COUNTS. GIVE LINE COUNT IN BITS 18-26 AND
1969: ; GLITCH COUNT IN 27-35. HIGH ORDER BIT OF FIELD ON MEANS DO NOT SET.
1970: 
1971: PPHLD:  SETZ AC1,
1972:         TRNE UUO,1B18           ; DOES HE WANT TO SET LINE COUNT?
1973:         JRST PPHLD1             ; NO, SKIP IT
1974:         DPB AC1,LHCSBU          ; NOTE SET BY UUO
1975:         LDB AC2,[POINT 8,UUO,26];used to say 25 instead of 26--ME 8-19-73
1976:         DPB AC2,HLINES          ; SET INTO PROGRAM HEADER
1977:         SKIPN AC2               ; ZERO MEANS DON'T HOLD AT ALL
1978:         SETO AC2,               ; WHICH IS SIGNIFIED BY -1
1979:         MOVEM AC2,LHCNT(DDB)    ; START IT GOING NOW
1980: PPHLD1: TRNE UUO,1B27           ;used to say 1b26--ME 8-19-73
1981:         JRST PPHLD2             ; NOW GO UNHOLD US
1982:         DPB AC1,GHCSBU
1983:         LDB AC2,[POINT 8,UUO,35]
1984:         DPB AC2,HGLTCH
1985:         SKIPN AC2
1986:         SETO AC2,
1987:         MOVEM AC2,GLHCNT(DDB)
1988: PPHLD2: SETZ AC1,
1989:         EXCH AC1,DPHOLD(DDB)
1990:         JUMPE AC1,CPOPJ
1991:         HRRZ AC1,PRGNUM(DDB)
1992:         ADD AC1,[XWD UNHOLD,DPYL0]
1993:         CONO PI,PIOFF
1994:         IDPB AC1,CLKQ
1995:         CONO PI,PION
1996:         POPJ P,
    DPYSER page# 0049 next  prev
1998: ; THIS ROUTINE GIVES THE USER A NICE LITTLE TABLE OF DATA ABOUT HIS
1999: ; PAGE PRINTER. THE TABLE IS =20 WORDS LONG. THE FIRST WORD IS
2000: ; XWD <POG ACT BITS>,<PP ACT BITS> WHICH ARE IN PPACT OR PGACT FORMAT.
2001: ; THE SECOND WORD IS THE NUMBER OF THE PIECE OF PAPER CURRENTLY SELECTED.
2002: ; THE THIRD WORD IS THE LINE EDITOR POSITION IN THE RH, BIT ZERO IS
2003: ; THE PAGE COLOR, AND BIT 1 SAYS WHETHER <ESC>C HAS BEEN TYPED SINCE YOU
2004: ; LAST GAVE THIS UUO, BIT 2 IS ON IF YOU ARE A DATA DISK DISPLAY.
2005: ; THE FOURTH THROUGH THE 19.TH WORDS ARE XWD <Y-POS>,<NG*1000+LPG> WHERE
2006: ; NG IS THE NUMBER OF GLITCHES AND LPG IS THE NUMBER OF LINES PER GLITCH.
2007: ; THIS IS CLEVERLY ARRANGED SO THAT A PPYPOS UUO WITH THE ARGUEMENT
2008: ; IN THE LH OF THIS WORD FOLLOWED BY A PPXSIZ WITH THE ARGUEMENT IN
2009: ; THE RH OF THIS WORD COMPLETELY RESTORES THAT PAGE.
2010: ; THE 20TH WORD IS A COPY OF GWORD. B0 MEANS PAGE PRINTER SIZE SET LAST
2011: ; BY USER COMMAND RATHER THAN BY UUO, B1 FOR Y-POSITION, B2 FOR LINE HOLD COUNT,
2012: ; AND B3 FOR GLITCH HOLD COUNT. BITS 9-17 HAVE THE ACTUAL LINE HOLD COUNT
2013: ; AND BITS 18-25 HAVE THE ACTUAL GLITCH HOLD COUNT. ZERO IF NOT BEING USED.
2014: 
2015: ↑PPSPY: HRR UUO,TAC             ;VERSION OF PPINFO FOR ANOTHER JOB'S DPY
2016:         HLRE ITEM,TAC           ;ARG IS JOB#,,OUTPUT BLOCK ADDR
2017:         JUMPL ITEM,PPSPY1       ; OR - LINE # IN LH
2018:         JUMPE ITEM,CPOPJ        ;NON-SKIP RETURN IF NO JOB OR NO DPY
2019:         CAILE ITEM,JOBN
2020:         POPJ P,
2021:         MOVE AC1,JBTSTS(ITEM)
2022:         TLNN AC1,JNA
2023:         POPJ P,
2024:         PUSHJ P,PRGF1           ;DON'T USE PRGFND TO FLANK DPYMAP HACK
2025: PPSPY2: SKIPA DAT,CURPP(DDB)    ;PRGF1 SKIP RETURNS ON FAILURE
2026:         POPJ P,                 ;NO DISPLAY
2027:         HLL DAT,DDB
2028:         AOS (P)                 ;OK, SET SKIP RETURN AND DROP THROUGH
2029: 
2030: PPINFO: MOVE AC1,PRGACT(DDB)    ; PICK UP HIS ACTIVATION BITS
2031:         XCTR    XW,[MOVEM AC1,(UUO)]
2032:         MOVE AC1,PPNO(DAT)      ; GET CURRENT PIECE OF PAPER NUMBER
2033:         XCTR    XW,[MOVEM AC1,1(UUO)]
2034:         LDB AC1,[POINT 11,LEPOS(DDB),21]
2035:         TRNE AC1,1⊗=10          ; EXTEND SIGN BIT
2036:         ORI AC1,-1⊗=10
2037:         MOVE AC2,DDCW(DAT)      ; PUT IN BLACK-WHITE BIT
2038:         TLNE AC2,(1B5)
2039:         TLO AC1,(1B0)
2040:         SETZ AC2,               ; PUT IN <ESC>C BIT
2041:         EXCH AC2,LECC(DDB)
2042:         SKIPE AC2
2043:         TLO AC1,(1B1)
2044:         JUMPGE DDB,.+2          ;DD OR III?
2045:         TLO AC1,(1B2)           ;DD, TURN ON BIT
2046:         XCTR    XW,[MOVEM AC1,2(UUO)]
2047:         ADDI UUO,3
2048: IFE 1,<
2049:         HRL AC1,UUO             ; NOW ZERO OUT THE TABLE
2050:         HRRI AC1,1(UUO)
2051:         XCTR XW,[SETZM (UUO)]
2052:         XCTR XRW,[BLT AC1,17(UUO)]
2053: >
2054: IFN 1,<
2055:         MOVEI AC1,17(UUO)
2056: PPINF0: XCTR XW,[SETZM (AC1)]
2057:         CAIE AC1,(UUO)
2058:         SOJA AC1,PPINF0
2059: >
    DPYSER page# 0050 next  prev
2061: ; PPINFO CONT - RUN DOWN LIST OF PP CTRL BLOCKS
2062: 
2063:         HLRZ AC1,PPCALL(DDB)    ; PICK UP POINTER TO FIRST PAGE PRINTER CONTROL BLOCK
2064: PPINF1: LDB AC2,[POINT 11,PPOSV(AC1),21]
2065:         TRNE AC2,1⊗10           ; SPREAD SIGN BIT ALL DOWN WORD
2066:         OR AC2,[-1⊗10]
2067:         LSH AC2,=9              ; MOVE IT OVER
2068:         ADD AC2,PGSIZ(AC1)      ; PUT IN THE NUMBER OF GLITCHES
2069:         LSH AC2,=9
2070:         ADD AC2,DEL(AC1)        ; AND THE NUMBER OF LINES PER GLITCH
2071:         MOVE AC3,PPNO(AC1)      ; PICK UP THE PIECE OF PAPER NUMBER
2072:         ADD AC3,UUO
2073:         XCTR    XW,[MOVEM AC2,(AC3)]    ; GIVE HIM THE WORD
2074:         HRRZ AC1,LINK(AC1)      ; PICK UP LINK TO NEXT PAGE PRINTER CONTROL BLOCK
2075:         JUMPN AC1,PPINF1        ; LOOP AROUND IF THERE IS ONE
2076:         MOVE AC1,GWORD(DDB)     ; PICK UP GARBAGE DUMP WORD
2077:         XCTR    XW,[MOVEM AC1,=19-3(UUO)]
2078:         POPJ P,
2079: 
2080: PPSPY1: MOVMS ITEM              ;NEGATIVE ARG TO PPSPY IS LINE #
2081:         MOVE DDB,LINTAB(ITEM)
2082:         TLNN DDB,DISLIN!DDDLIN
2083:         POPJ P,
2084:         HRRZ DDB,LETAB-DPYL0(DDB)
2085:         JUMPE DDB,CPOPJ         ;NO DDB
2086:         PUSHJ P,PRGF3           ;SETS UP DD BIT IN DDB
2087:         JRST PPSPY2
    DPYSER page# 0051 next  prev
2089: ; THIS IS THE ROUTINE FOR A UUO WHICH SETS YOUR LINE EDITOR'S VERTICAL
2090: ; POSITION. THE EFFECTIVE ADDRESS OF THE UUO IS SAID POSITION IN
2091: ; PPYPOS FORMAT. Y-POSITION OF ZERO IS VERBOTTEN AND MEANS RETURN TO
2092: ; THE BOTTOM OF THE PAGE PRINTER.
2093: 
2094: LEYPOS: MOVE AC1,[BYTE (11)<-777>,0(3)0,0(2)1,2(3)3]
2095:         TRNN UUO,-1             ; IS THE POSITION ZERO?
2096:         SKIPA AC1,[DISNOP]      ; YES, PUT A NO-OP IN
2097:         DPB UUO,[POINT 11,AC1,21]
2098:         MOVEM AC1,LEPOS(DDB)    ; PUT IT IN BEFORE THE LINE EDITOR CALL
2099:         JUMPG DAT,CPOPJ
2100:         SETO AC1,               ; QUEUE UP A LINE EDITOR REQUEST TO GET IT REPOSITIONED
2101:         EXCH AC1,LECLK(DDB)
2102:         JUMPN AC1,CPOPJ
2103:         HRR AC1,DDB
2104:         HRLI AC1,DPLED
2105:         CONO PI,PIOFF
2106:         IDPB AC1,CLKQ
2107:         CONO PI,PION
2108:         POPJ P,
    DPYSER page# 0052 next  prev
2110: ;;FREEL FREES A LIST OF BLOCKS POINTED TO BY AC1, AND UPDATES
2111: ;; THE USER'S BLKTOT.  
2112: 
2113: FOOFRL: HRRZ AC1,UUO
2114:         PUSHJ P,FSGIVE
2115:         HRRZ AC1,TAC1
2116:         JUMPE AC1,CPOPJ
2117: FREEL:  HRRZ AC3,LINK(AC1)      ;GET CDR OF LIST.
2118:         PUSHJ P,CGIVFS          ;FREE CAR OF LIST.
2119:         MOVEM AC3,AC1
2120:         JUMPN AC1,FREEL         ;FREE CDR.
2121:         POPJ P,
2122: 
2123: DPYFOO: JSP AC3,FNDJOB          ;GET JOB NO. (GETJOB IS IN MAIL).
2124:         EXCH DAT,ITEM           ;PRETEND IT'S OURS...
2125:         PUSHJ P,PRGFND          ;FIND ASSOCIATED DPY PRGM.
2126:         POPJ P,                 ;SHOULDN'T LOSE ANY MORE THAN ANYONE ELSE
2127:         MOVEM DDB,DPYMAP(DAT)   ;ENTER IN OUR TABLE.
2128:         POPJ P,                 ;WE WILL NOW USE OTHER GUY'S DPY PRGM.
    DPYSER page# 0053 next  prev
2130: ;;UPG IS THE DEMOCRATIC UUO WHICH ALLOWS ALL MEN,
2131: ;; HOWEVER HUMBLE THEIR STATION (PROVIDED IT IS TY20
2132: ;; OR HIGHER) TO RUN THEIR VERY OWN DISPLAY 
2133: ;; PROGRAMS.
2134: 
2135: ↑UPGIOT:        BEGIN UPG
2136: 
2137: T2←DSER
2138: PBSZ←←CNT       ;DPY INSTRS /BLOCK.
2139: SIZE←←=17
2140: PGWC←←0
2141: PGSA←←1
2142: PGNP←←2
2143: 
2144:         PUSHJ P,PGSET           ;GET REQUESTED P OF G .
2145:         POPJ P,                 ;NO SUCH DPY, LEAVE NOW
2146:         JUMPL DDB,DDUPG
2147:         MOVEM ITEM,CURPG(DDB)
2148:         XCTR    XR,[HRLZ TEM,(UUO)]     ;STARTING ADDR. OF PRGM.
2149:         XCTR    XR,[MOVM AC3,1(UUO)]    ;LENGTH OF PRGM.
2150:         CAIL AC3,NBS*PBSZ       ;IS PIECE OF GLASS GOING TO BE TOO BIG ?
2151:         JRST UPGTB
2152:         HRLZM AC3,UCHN          ;SAVE WC IN LEFT OF UCHN, MAKE RIGHT HALF 0 FOR NOW.
2153:         MOVEI TAC,PBSZ-1+PGNP(AC3)
2154:         IDIVI TAC,PBSZ          ; FIND OUT HOW MANY BLOCKS THIS PROGRAM WILL CONSUME
2155:         MOVEI T2,(TAC)
2156:         SUB TAC,SIZE(ITEM)      ;HOW BIG IS THIS PG NOW ?
2157:         ADD TAC,BLKTOT(DDB)     ;THIS IS HOW MUCH IT GROWS.
2158:         JUMPG TAC,UPGER1        ;IS USER OVER HIS ALLOTMENT ?
2159:         HRREI TAC,-1(T2)        ;SAVE IT.
2160:         SETZM SIZE(ITEM)        ;...SEE FOLLOWING INSTR.
2161:         MOVEI TAC1,DISNOP       ;SEE FOLLOWING INSTR...
2162:         JUMPE AC3,UPREL1        ;IF WC IS 0, RELEAS PAGE.
2163:         MOVEI AC3,NBS+2         ; NICE BIG PIECE
2164:         PUSHJ P,UGETF1          ;GET BLOCK FOR THE RELOCATION TABLE.
2165:         JUMPL AC1,CPOPJ         ;IF WE ARE AT SPACEWAR LEVEL AND NO FREE STG., JUST RETURN.
2166:         MOVEM AC1,UUO
2167:         MOVEI TAC1,0
2168:         TLOA UUO,TAC            ;MAKE UUO AN INDEXED POINTER TO REL. TBL.
2169: L1:     MOVEM AC1,TAC1          ;SAVE LOC. OF THIS BLOCK.
2170:         PUSHJ P,CGETFS          ;GET A BLOCK OF FREE STG.
2171:         JUMPL AC1,FOOFRL        ;GO AWAY IF SPACEWAR AND NO FREE STG.
2172:         MOVSM AC1,@UUO          ;ENTER IN RELOCATION TABLE.
2173:         MOVEM TAC1,LINK(AC1)    ;LINK TO PREVIOUS BLOCK.
2174:         SOJGE TAC,L1            ;GET REST OF BLOCKS NEEDED.
2175:         MOVEM T2,SIZE(ITEM)     ;UPDATE SIZE OF THIS PG.
    DPYSER page# 0054 next  prev
2177:         MOVN TAC1,UCHN          ;LENGTH OF USERS CODE.
2178:         HLR TAC1,TEM            ;STARTING ADDR.
2179:         HRR UCHN,UUO            ;BOTTOM OF RELOCATION TABLE.
2180:         HLRZ T2,(UUO)
2181:         ADD UCHN,[XWD PGNP,0]
2182:         HLRZM UCHN,PGWC(T2)
2183:         HLRZM TEM,PGSA(T2)
2184:         ADD T2,[XWD -PBSZ+PGNP,PGNP]
2185: LOOP:   XCTR    XR,[MOVE (TAC1)]        ;PICK UP WORD FROM PRGM.
2186:         TRNN 3                  ;DOES IT NEED EXAMINING ?
2187:         PUSHJ P,SPECOP          ;YES, IT IS A POTENTIALLY DANGEROUS INSTR.
2188:         MOVEM (T2)              ;STORE THE INSTR.
2189:         AOBJP TAC1,DONE         ;AT END OF PGM. ?
2190:         AOBJN T2,LOOP           ;NO. END OF BLOCK ?
2191:         MOVE 1(UCHN)            ;YES. GET START OF NEXT ONE.
2192:         HRRI DISJMP             ;FORM JMP INSTR. TO IT.
2193:         MOVEM (T2)              ;PLACE AT END OF LAST BLOCK.
2194:         ADD [XWD 1,0]           ;MAKE JMP GO TO 2ND WORD OF NEW BLOCK..
2195:         MOVEM 1(T2)             ;...IN CASE THERE IS A TSS WHICH SKIPS..
2196:         HLR T2,1(UCHN)          ;GET START OF CURRENT BLOCK.
2197:         HRLI T2,-PBSZ           ;LENGTH OF BLOCK.
2198:         AOJA UCHN,LOOP          ;GO FILL NEXT BLOCK.
2199: 
2200: UPGTB:  ERMS {PIECE OF GLASS TOO BIG.}
2201:         POPJ P,
2202:         
2203: SPECOP: LDB AC1,[POINT 3,0,33]  ;GET OPCODE.
2204:         XCT SPCTBL(AC1)         ;DO APPROPRIATE THING.
2205:         POPJ P,                 ;STORE INSTR.
2206: 
2207: DONE:   MOVE TAC1,(UUO)         ;START OF BLOCK 0 OF PRGM.
2208:         ADD TAC1,[XWD PGNP,DISJMP]
2209:         MOVEM TAC1,1(T2)        ;MAKE END OF PGM JMP BACK TO START.
2210:         MOVEM TAC1,2(T2)
2211:         HRRZ AC1,UUO            ;NOW RELEASE THE RELOC. TABLE.
2212:         PUSHJ P,FSGIVE
2213:         HRRI TAC1,DISJSR        ;JSR TO START OF PGM.
2214: ↑UPREL1:HLRZ AC1,PGCALL(DDB)
2215:         SUBI AC1,(ITEM)         ;GET NEG POG #
2216:         MOVSI AC2,400000
2217:         LSH AC2,(AC1)           ;MAKE PGACT BIT
2218:         TRNE TAC1,20
2219:         IORM AC2,PRGACT(DDB)    ;IS JSR - MARK ACTIVE
2220:         TRNN TAC1,20
2221:         ANDCAM AC2,PRGACT(DDB)  ;IS NOP - MARK INACTIVE
2222:         EXCH TAC1,(ITEM)        ;EXCHANGE FOR OLD ONE.
2223:         HLRZS AC1,TAC1          ;GET START OF OLD PRGM.
2224:         JUMPE TAC1,CPOPJ        ;RETURN IF NO OLD PRGM.
2225:           ;FREE THE OLD PRGM.,AND FIX PRGM TO RESTART AT TOP.
2226:         SUBI AC1,PGNP
2227:         JRST SETRST             ;SETRST IS IN PRINT.
    DPYSER page# 0055 next  prev
2229: ;;MORE OF UPG.
2230: 
2231: ;;SPCTBL IS DISPATCH TABLE FOR HANDLING SPECIAL DPY INSTRS.
2232: 
2233: SPCTBL: JRST HLTOP      ;HALT
2234:         JRST ILLJMS     ;JMS
2235:         JRST SELCHK
2236:         JRST ADRRST     ;RST (NO BITS ON -- NOOP) (DCS-5/29/70)
2237:         JRST ADROP      ;JMP
2238:         JRST ADROP      ;JSR OR SAVE
2239:         JRST SELCHK
2240:         JRST ADROP      ;RST (AGAIN.)
2241: 
2242: SELCHK: MOVE TAC,JOB
2243:         MOVE TAC,JBTPRV(TAC)
2244:         TLNE TAC,UPGPRV                 ;RETURN QUICK IF HE HAS THE PRIV
2245:         POPJ P,                         ;HE HAS THE PRIVILEGE
2246:         MOVE TAC,[<77770010>⊗DPYNUM]    ;DESELECT ANYONE.
2247:         MOVEI AC2,DPYNUM-1              ;DPY'S ONLY.
2248:         PUSH P,TAC1
2249: LOOPS:  LSH TAC,-1                      ;SHIFT MASK.
2250:         SKIPN AC3,TTYTAB+DPYL0(AC2)     ;POINTER TO DPY DDB.
2251:         JRST DCHNOK             ;SELECT OK!
2252:         MOVE TAC1,DEVMOD(AC3)
2253:         LDB AC3,[POINT 6,1(AC3),5]      ;GET # OF JOB THAT HAS THAT DPY.
2254:         TDNE TAC1,[XWD TTYATC,ASSCON!ASSPRG]
2255:         CAMN AC3,JOB(PID)                       ;THIS ONE?
2256: DCHNOK: TLO TAC,400000                  ;SELECT BIT.
2257:         SOJGE AC2,LOOPS
2258:         POP P,TAC1
2259:         MOVSI AC2,400000                ;GET A BIT.
2260:         MOVN AC3,PRGNUM(DDB)            ;DPY NUMBER THIS PROG.(0 TO DPYNUM-1)
2261:         LSH AC2,(AC3)
2262:         TDO TAC,AC2                     ;MAKE SURE HE GETS HIS OWN.
2263:         AND TAC
2264:         POPJ P,
    DPYSER page# 0056 next  prev
2266: ; RST WITH NO PARAM BITS ON IS A NOOP -- ALLOW ANY ARGUMENT
2267: ; TO APPEAR UNCHANGED IN THE LEFT HALF
2268: 
2269: ADRRST: TRNN    60              ;SIZE OR [X,Y] FIELDS ON?  (DCS-5/29/70)
2270:          POPJ    P,             ; NO, LEAVE IT ALONE       (DCS)
2271: 
2272: ;CALL ADROP WITH THE FOLLOWING
2273: ;       0       XWD <ADDRESS TO CHECK>,<ANYTHING>
2274: ;       TEM     XWD <USER BASE ADDRESS>,<ANYTHING>
2275: ;       UCHN    XWD <LENGTH OF USER BUFFER>,<ANYTHING>
2276: ;       UUO     XWD TAC,<ADDRESS OF RELOCATION TABLE>
2277: ;       TAC1    XWD <ANYTHING>,<ADDRESS TO TYPE OUT ON ERROR>
2278: 
2279: ADROP:  SUB TEM                 ;AN ADDRESSABLE INSTR. UNRELOCATE IT.
2280:         CAML UCHN               ;ADDRESS TOO HIGH ?
2281:         JRST ILLAD              ;YUP.
2282:         ADD 0,[XWD PGNP,0]      ; SKIP OVER HEADER WORDS
2283:         HLRE AC1,0              ; PICK UP ADDRESS
2284:         IDIVI AC1,PBSZ          ; GET # BLOCKS AND DISPLACEMENT INTO LAST BLOCK
2285:         HRL 0,AC2               ; USE DISPLACEMENT INTO BLOCK PLUS ADDRESS OF BLOCK
2286:         MOVE TAC,AC1
2287:         ADD @UUO                ;ADD IN RIGHT RELOCATION.
2288:         JUMPGE AC1,CPOPJ        ;WAS ADDRESS TOO SMALL ?
2289: ILLAD:  PUSHJ P,DPYERR          ;ILLEGAL ADDRESS IN DPY INSTR.
2290:         ERMS {ILLEGAL INSTR. ADDRESS.}
2291: ILL1:   MOVEI DISNOP            ;REPLACE OFFENDING INSTR. WITH NOP.
2292:         POPJ P,
2293: 
2294: ILLJMS: PUSHJ P,DPYERR
2295:         ERMS {JMS NOT LEGAL; USE JSR.}
2296:         JRST ILL1
2297: 
2298: HLTOP:  MOVE (UUO)              ;REPLACE HLT WITH RETURN JMP.
2299:         ADD [XWD PGNP,DISJMP]
2300:         POPJ P,
2301: 
2302: UPGER1: ERMS {TOTAL DPY BUFFER SPACE EXCEEDED.}
2303:         POPJ P,
    DPYSER page# 0057 next  prev
2305: ; DATA DISC PROGRAM HANDLER
2306: ; SENDS THE PROGRAM DIRECTLY OUT OF LOSER CORE IN EXEC MODE
2307: 
2308: ;EXTENDED FEATURES:
2309: ;BIT 0 OF HEADER WD 0 => OVERLAPPED XFER (RETURNS WITHOUT WAITING)
2310: ; IN THIS MODE HEADER WD 2 ≠ 0 => XFER GOING.
2311: ; DPYOUT ALWAYS WAITS FOR PREV XFER, SO DPYOUT WITH WC=0 WILL
2312: ; WAIT FOR BUFFER TO BE AVAIL.
2313: ;BIT 1 OF HEADER WD 0 => DOUBLE FIELD MODE, WHICH DOES XFER
2314: ; TWICE - ONCE ON EACH FIELD. HEADER WD 3 SHOULD POINT TO WORD
2315: ; OF BUFFER CONTAINING (ONLY) LOW-ORDER LINE ADDRESS SELECT
2316: ; AS 3RD COMMAND BYTE. THIS BYTE WILL BE ADJUSTED TO APPROP
2317: ; FIELD ON EACH XFER.
2318: 
2319: DDUPG:  SKIPE DDOFF             ; DO WE HAVE A DATA DISC TODAY
2320:         POPJ P,                 ; NO, SPEAK NO EVIL!
2321:         PUSHJ P,DDWAIT          ;WAIT FOR PREV XFER, IF ANY
2322:         XCTR    XR,[SKIPGE AC1,(UUO)]   ; PICK UP ADDRESS OF USER BUFFER
2323:         XCTR    XW,[SETZM 2(UUO)]       ;INIT XFER IN PROGRESS FLAG IF USED
2324:         XCTR    XR,[SKIPG AC2,1(UUO)]   ; PICK UP WORD COUNT OF BUFFER
2325:         POPJ P,                 ;THAT WAS EASY
2326:         ADDI AC2,-1(AC1)        ; MAKE POINTER TO LAST WORD
2327:         XCTR    XR,[SKIPE (AC2)]        ;DON'T CLOBBER IF OK (MIGHT BE UPPER)
2328:         XCTR    XW,[SETZM (AC2)]        ; PUT A HALT THERE AT THE END OF THE BUFFER
2329:         MOVEI AC3,10            ; WE WILL LOOK IN THIS FAR FOR A CHANNEL SELECT
2330: DDCWL:  XCTR    XR,[MOVE AC2,(AC1)]     ; PICK UP WORD OF PROGRAM
2331:         LDB TAC,[POINT 3,AC2,35]
2332:         CAIN TAC,4              ; IS IT A COMMAND WORD?
2333:         JRST CHKAD              ; YES, SEE IF IT HAS A CHANNEL SELECT IN IT
2334: DDCINC: ADDI AC1,1              ; BUMP POINTER INTO USER CORE
2335:         SOJG AC3,DDCWL          ; BUMP COUNT OF DEPTH AND LOOP BACK
2336:         HLRE TAC,PRGNUM(DDB)    ; NO CHANNEL SELECT, SEE IF WE CAN SEND TO HIS OWN SCREEN
2337:         JUMPGE TAC,DDSCHN
2338:         JRST ILLCHN
2339: 
2340: DDWAIT: SKIPN PRGCNT(DDB)
2341:         POPJ P,                 ;NOTHING GOING ON
2342:         MOVNI AC2,DIOWQ
2343:         MOVEI AC3,400000
2344:         CONO PI,APROFF
2345:         SKIPN PRGCNT(DDB)
2346:         JRST APRONJ             ;MUST HAVE JUST FINISHED
2347:         MOVEM AC2,JOBQUE(J)
2348:         IORM AC3,PRGJMP(DDB)    ;TELL PI ROUTINES TO WAKE US
2349:         CONO PI,APRON
2350:         SKIPGE JBTLIN(J)
2351:         JRST WSCHED             ;AVOID RETESTING IF DETACHED (HEADER WILL GO AWAY)
2352:         PUSHJ P,WSCHED          ;WAIT FOR IT
2353:         JRST DDWAIT             ;THEN CHECK AGAIN TO BE SURE
2354: 
2355: APRONJ: CONO PI,APRON
2356:         POPJ P,
    DPYSER page# 0058 next  prev
2358: ; HERE WE ARE, READY TO SET THE CHANNEL ADDRESS OF HIS DATA DISC PROGRAM
2359: 
2360: DDSCHN: MOVE AC1,[CW 1,47,3,1,2,0]
2361:         DPB TAC,[POINT 8,AC1,23]
2362:         MOVEM AC1,PRGCW(DDB)    ; PUT IN COMMAND WORD WITH CHANNEL SELECT
2363:         XCTR    XR,[MOVE AC2,(UUO)]
2364:         PUSHJ P,CHKADR
2365:         HRLI AC2,DISJMP
2366:         MOVSM AC2,PRGJMP(DDB)   ; PUT IN JUMP TO USER'S PROGRAM
2367:         MOVEI TAC,
2368:         XCTR    XR,[SKIPL (UUO)]        ;OVERLAPPED MODE?
2369:         JRST UPGQ0              ;NO
2370:         XCTR    XRW,[MOVES 2(UUO)]      ;BE SURE WE CAN WRITE HERE
2371:         MOVEI AC2,2(UUO)
2372:         PUSHJ P,CHKADR
2373:         MOVEI TAC,(AC2)         ;SAVE ABS ADR FOR PI ROUTINES
2374: UPGQ0:  PUSHJ P,GETQ
2375:         XCTR    XR,[MOVE AC3,(UUO)]
2376:         TLNN AC3,200000         ;DOUBLE FIELD MODE?
2377:         JRST UPGQ1              ;NO
2378:         XCTR    XR,[HRRZ AC2,3(UUO)]    ;ADR OF WORD WITH LINE SELECT
2379:         XCTR    XRW,[MOVES (AC2)]       ;CHECK WRT ACCESS HERE
2380:         PUSHJ P,CHKADR
2381:         HRLI TAC,(AC2)          ;SAVE THIS ADR
2382:         PUSH P,AC1
2383:         PUSHJ P,GETQ            ;WILL NEED 2 Q BLKS
2384:         SETOM QFIELD(AC1)
2385:         PUSHJ P,UPGQ
2386:         POP P,AC1
2387: UPGQ1:  SETZM QFIELD(AC1)
2388:         PUSHJ P,UPGQ
2389:         XCTR    XR,[SKIPL (UUO)]        ;OVERLAPPED?
2390:         JRST DDWAIT             ;NO - WAIT
2391:         POPJ P,                 ;YES - RETURN
2392: 
2393: UPGQ:   HRLM    DDB,(AC1)       ;LOAD UP TASK BLOCK WITH PROGRAM HEADER
2394:         MOVEI   AC2,POG         ;DISPATCH TO USER PROGRAM SERVICE
2395:         HRRM    AC2,(AC1)
2396:         MOVEI   AC2,PRGCNT(DDB) ;PICK UP ADDRESS OF FAKE COUNT FIELD
2397:         MOVEM   AC2,QCOUNT(AC1)
2398:         MOVEM   TAC,QHPOS(AC1)  ;STORE SPEC ADRS
2399:         TRNE    TAC,-1
2400:         AOS     (TAC)           ;COUNT XFER GOING (FOR LOSER)
2401:         AOS     PRGCNT(DDB)     ;AND FOR US
2402:         MOVEM   J,QWAKE(AC1)
2403:         MOVE    AC2,[XWD 1,50]  ; MAKE IT LOOK LIKE IT WILL TAKE ENTIRE SCREEN
2404:         MOVEM   AC2,QLINE(AC1)
2405:         AOS     JBTGLU(J)       ;KEEP US AROUND
2406: IFN FTSTAT,<PUSHJ P,GLUSTT>
2407:         JRST    QBLOCK
    DPYSER page# 0059 next  prev
2409: ; GET HERE TO LOOK AT A USER'S COMMAND WORD AND SEE IF THERE IS A CHANNEL SELECT
2410: 
2411: CHKAD:  LDB TAC,[POINT 3,AC2,26]
2412:         CAIN TAC,2              ; IS IT A CHANNEL SELECT?
2413:         JRST CHKAC1             ; YES, SEE IF IT IS LEGAL.
2414:         LDB TAC,[POINT 3,AC2,29]
2415:         CAIN TAC,2
2416:         JRST CHKAC2
2417:         LDB TAC,[POINT 3,AC2,32]
2418:         CAIN TAC,2
2419:         JRST CHKAC3
2420:         JRST DDCINC
2421: 
2422: CHKAC1: LDB TAC,[POINT 8,AC2,7]
2423: CHKAC4: PUSHJ P,CHAD
2424:         JRST DDSCHN
2425: 
2426: CHKAC2: LDB TAC,[POINT 8,AC2,15]
2427:         JRST CHKAC4
2428: 
2429: CHKAC3: LDB TAC,[POINT 8,AC2,23]
2430:         JRST CHKAC4
2431: 
2432: ;CHECK & RELOC USER ADR
2433: CHKADR: HLRZ AC3,JBTADR(J)
2434:         CAIGE AC3,(AC2)
2435:         JRST CHKADU             ;PAST LOWER - TRY UPPER
2436:         ADD AC2,JBTADR(J)
2437:         POPJ P,
2438: 
2439: CHKADU: TRZN AC2,400000
2440:         JRST UUOERR             ;CAN'T BE UPPER
2441:         TRZE AC3,400000
2442:         SUBI AC2,1(AC3)
2443:         LDB AC3,PSEGN
2444:         JUMPE AC3,UUOERR        ;NO UPPER
2445:         HLRZ AC3,JBTADR(AC3)
2446:         CAIGE AC3,(AC2)
2447:         JRST UUOERR             ;TOO BIG
2448:         LDB AC3,PSEGN
2449:         ADD AC2,JBTADR(AC3)
2450:         POPJ P,
    DPYSER page# 0060 next  prev
2452: ;CHANNEL ADDRESS CHECKING. HE CAN WRITE ON HIS OWN SCREEN,
2453: ;OR ON ANY CHANNEL HE OWNS, OR ON ANY FREE CHANNEL.
2454: 
2455: CHAD:   JUMPE TAC,MYCHN         ;GIVE HIM HIS OWN FOR 0
2456:         ANDI TAC,37
2457:         MOVEI AC1,(TAC)
2458:         PUSHJ P,DDCHEK
2459:         POPJ P,         ;FREE
2460:         JRST .+2
2461:         POPJ P,         ;HE OWNS IT
2462:         MOVE AC1,JBTPRV(J)
2463:         MOVE AC2,DDTAB(TAC)
2464:         TLNN AC2,DDANYW         ;MAYBE OWNER SAYS IT'S OK
2465:         TLNE AC1,UPGPRV
2466:         POPJ P,         ;HE CAN WRITE ANYWHERE WITH THE PRIVILEGE
2467: MYCHN:  HLRE TAC,PRGNUM(DDB)    ;GIVE HIM HIS OWN CHANNEL (IF ANY)
2468:         JUMPGE TAC,CPOPJ        ;WIN
2469:         SUB P,[1,,1]
2470: ILLCHN: MOVEI AC1,(DDB)
2471:         SKIPE DPRLSF(DDB)
2472:         PUSHJ P,FSGIVE  ;MAKE SURE THE PHONY HEADER GETS RETURNED
2473:         PUSHJ P,TTYFUW
2474:         PUSHJ P,INLMES
2475:         ASCIZ /ILLEGAL DD CHANNEL.
2476: /
2477:         JRST TYPGO
    DPYSER page# 0061 next  prev
2479: ;;PGSET  SETS UP REQUESTED PIECE OF GLASS.
2480: 
2481: ↑PGSET: PUSHJ P,PRGFND          ;FIND USER'S DPY PGM.
2482:         POPJ P,                 ;NO DISPLAY HERE
2483:         JUMPL DDB,CPOPJ1
2484: PGSETA: HLRZ ITEM,PGCALL(DDB)   ;PTR. TO PG HEADER.
2485:         JUMPE ITEM,PGSET1       ;IF NONE, START FROM SCRATCH.
2486:         CAMLE UCHN,LSTPG(DDB)   ;DOES THIS PG ALREADY "EXIST" ?
2487:         JRST PGSET2             ;NO. GO EXTEND THE HEADER.
2488:         ADDI ITEM,(UCHN)        ;YES. MAKE ITEM POINT AT
2489:         JRST CPOPJ1             ;THE CALLING INSTR. FOR IT.
2490: PGSET1: PUSHJ P,CGETFS          ;GET BLOCK TO USE FOR PG HEADER.
2491:         MOVEM AC1,ITEM
2492:         SETOM LSTPG(DDB)        ;NO PG'S EXIST YET.
2493:         HRLI TAC1,PGCALL+1(DDB) ;INVENT RETURN JMP TO PGM HEADER.
2494:         HRRI TAC1,DISJMP
2495:         MOVEM TAC1,(ITEM)       ;PUT IN FIRST WORD OF PG HEADER.
2496:         HRLI ITEM,DISJMP
2497:         MOVSM ITEM,PGCALL(DDB)  ;FIX CALL ON PG HEADER.
2498: PGSET2: MOVEI TAC1,DISNOP       ;EXTEND ACTIVE PART OF PG HEADER.
2499:         ADD ITEM,LSTPG(DDB)     ;GET LAST CURRENT PAGE.
2500:         EXCH UCHN,LSTPG(DDB)
2501:         SUB UCHN,LSTPG(DDB)     ;NO. OF PLACES TO EXTEND.
2502:         HRLI ITEM,(UCHN)        ;MAKE AOBJN WORD.
2503:         MOVE UCHN,1(ITEM)       ;GET RETURN JMP.
2504: PGSL1:  MOVEM UCHN,2(ITEM)      ;PUT RTN JMP FARTHER UP.
2505:         MOVEM TAC1,1(ITEM)      ;PUT NOP WHERE IT USED TO BE.
2506:         SETZM SIZE+1(ITEM)      ;THIS PG IS NOW 0 SIZE.
2507:         AOBJN ITEM,PGSL1
2508:         JRST CPOPJ1
    DPYSER page# 0062 next  prev
2510: ; THIS IS THE DPY ERROR ROUTINE. IT TYPES OUT THE PC IN TAC1 ON
2511: ; THE DISPLAY.
2512: 
2513: DPYERR: PUSH P,TEM
2514:         PUSH P,TAC1
2515:         JSA ITEM,ERRP           ;DO THIS SO NO TERMINATING CRLF
2516:         POINT 7,[ASCIZ/$$ USER DPY ERROR AT /]
2517:         HRR AC1,(P)
2518:         MOVEI AC2,6
2519: DPYER1: HRRZS AC1
2520:         LSH AC1,3               ;GET ONE OCTAL DIGIT.
2521:         TLO AC1,60
2522:         LDB CHR,[POINT 7,AC1,17]
2523:         PUSH P,AC1              ; SAVE ALL OUR RELEVANT DATA
2524:         PUSH P,AC2
2525:         MOVE DAT,CURPP(DDB)     ; PICK UP PAGE PRINTER CONTROL BLOCK ADDRESS
2526:         HLL DAT,DDB             ; PUT IN DD BIT
2527:         CONO PI,SCNOFF          ;TURN OFF RPH
2528:         PUSHJ P,TYO             ;PRINT  IT.
2529:         CONO PI,SCNON           ;TURN ON RPH
2530:         POP P,AC2
2531:         POP P,AC1
2532:         SOJG AC2,DPYER1
2533:         ERMS {}
2534:         POP P,TAC1
2535:         POP P,TEM
2536:         POPJ P,
    DPYSER page# 0063 next  prev
2538: ↑↑UPGMVM:PUSHJ P,UPGMV          ;DO `MOVEM' INTO P OF G: TAKE CARE OF PRELIMINARIES.
2539:         POPJ P,                 ;IGNORE IF NO CAN DO
2540:         TRNN 3                  ;IF THING BEING STORED IS A COMPLICATED DPY INSTR.,
2541:         PUSHJ P,SPECOP          ; THEN CHECK AND RELOCATE IT.
2542:         MOVSS DAT               ;GET RELOCATED ADDRESS OF THE UPGMVM.
2543:         MOVEM (DAT)             ;DO THE STORE.
2544:         POPJ P,
2545: 
2546: ↑↑UPGMOV:PUSH P,UCHN            ;DO A `MOVE' FROM THE CURRENT P OF G.
2547:         PUSHJ P,UPGMV           ;LET SOMEBODY ELSE DO THE REAL WORK !
2548:         TDZA DAT,DAT            ;RETURN 0 IF NO CAN DO
2549:         JRA DAT,.+1             ;HO, HO, HO.  SEE THE CLEVER PROGRAMMER.
2550:         POP P,UCHN              ; P1ULOC DOESN'T HAVE OUR UUO ANY MORE, MUST SAVE CHANNEL NUMBER OURSELVES
2551:         XCTR    XW,[MOVEM DAT,(UCHN)]   ;PUT RESULT IN USER'S AC.
2552:         POPJ P,
2553: 
2554: UPGMV:  PUSHJ P,PRGFND          ;COMMON ROUTINE FOR UPGMOV AND UPGMVM. FIND PRGM.
2555:         POPJ P,                 ;NO DPY, NO MOVY
2556:         JUMPL DDB,CPOPJ
2557:         SKIPE ITEM,CURPG(DDB)   ;GET CURRENTLY SELECTED P OF G.
2558:         SKIPN SIZE(ITEM)        ;MAKE SURE IT EXISTS.
2559:         POPJ P,
2560:         XCTR    XR,[MOVE DAT,(UCHN)]    ;PICK UP CONTENTS OF USER'S AC.
2561:         MOVS T2,(ITEM)          ;GET PTR. TO THE P OF G.
2562:         SUBI T2,PGNP            ;MAKE IT POINT TO THE DESCRIPTOR WORDS.
2563:         HRLZ TEM,PGSA(T2)       ;STARTING ADDR. (IN USER CORE) OF P OF G.
2564:         HRLZ UCHN,PGWC(T2)      ;LENGTH OF P OF G.
2565:         HRLZ UUO                ;ADDRESS OF THE `MOVE' OR `MOVEM'.
2566:         MOVE UUO,[XWD TAC,TBL]  ;PREPARE TO GENERATE A BLOCK MAP FOR
2567:         HRLZM T2,(UUO)          ;THE P OF G. (PUT IN BOTTOM PTR.).
2568:         SKIPE T2,LINK(T2)       ;GET NEXT BLOCK, IF ANY.
2569:         AOJA UUO,.-2            ;PUT IT IN MAP.
2570:         HRRI UUO,TBL            ;MAKE UUO POINT TO MAP.
2571:         HLRZ TAC1,0             ;PRINT THIS ADDRESS IN EVENT OF ERROR!
2572:         PUSHJ P,ADROP           ;NOW RELOCATE AND CHECK ADDR. OF MOVE.
2573:         EXCH DAT,0              ;PUT OPERAND (IF `MOVEM') INTO 0.
2574:         JRST CPOPJ1
    DPYSER page# 0064 next  prev
2576: ↑↑PGIOT:
2577:         CAIL UCHN,PGMAX         ;GENERAL P OF G SERVICE IOT.
2578:         JRST UUOERR
2579:         PUSHJ P,DDFND           ; FIND A PROGRAM HEADER (UCHN =3 GAURANTEES ONE)
2580:         POPJ P,                 ;IGNORE IF NO DISPLAY
2581:         JUMPG DDB,@PGDSP(UCHN)  ; IF III, DISPATCH NOW
2582:         CAIGE UCHN,3            ; ONLY ONES LEGAL FOR DD CURRENTLY
2583:         POPJ P,                 ; ALL THE OTHERS DON'T MAKE SENSE.
2584:         JRST @PGDSP(UCHN)       ;INDEX REG FIELD WAS MISSING, SO
2585:                                 ; ONLY PGSEL WAS AVAILABLE -- DCS (6/2/70)
2586: 
2587: DEFINE UUOS{FOR X IN(PGSEL,PGACT,PGCLR,DDUPG,PGINFO)}
2588: 
2589: UUOMAC PGDSP,PGIOT
2590: PGMAX←←UUOCNT
2591: 
2592: PGSEL:  HRRZ UCHN,UUO           ;SELECT THE P OF G INDICATED BY THE ADDR. FIELD.
2593:         CAIL UCHN,20            ;IS IT LEGAL ?
2594:         JRST ADRERR
2595:         PUSHJ P,PGSETA          ;FIND THE P OF G.
2596:         POPJ P,                 ;SHOULD NEVER GET HERE, BUT PGSETA SKIP RETURNS
2597:         MOVEM ITEM,CURPG(DDB)   ;MAKE IT THE CURRENTLY SELECTED ONE.
2598:         POPJ P,
2599: 
2600: ↑VPGACT:MOVEI DDB,(DAT)         ;HERE ON CLK RQ FROM VDSTR
2601:         HLRZ UUO,PRGACT(DDB)    ;THIS MAKES THE PROGRAM AGREE WITH THE BITS
2602: PGACT:  HLRZ ITEM,PGCALL(DDB)
2603:         JUMPE ITEM,CPOPJ
2604:         HRLM UUO,PRGACT(DDB)
2605:         MOVE TAC,LSTPG(DDB)
2606:         MOVEI AC1,DISNOP
2607:         MOVEI AC2,DISJSR
2608: PGACL:  SKIPN SIZE(ITEM)
2609:         JRST PGAC1
2610:         HRRM AC1,(ITEM)
2611:         TRNE UUO,400000
2612:         HRRM AC2,(ITEM)
2613: PGAC1:  ROT UUO,1
2614:         SOJL TAC,CPOPJ
2615:         AOJA ITEM,PGACL
2616: 
2617: ;;PGCLR FLUSHES ANY PIECES OF GLASS A LOSER MAY HAVE.  DDB SHOULD BE SET UP POINTING TO PRGM HEADER.
2618: 
2619: ↑PGCLR: SETZM CURPG(DDB)
2620:         HLRZ ITEM,PGCALL(DDB)   ;GET PTR. TO PG HEADER BLK.
2621:         JUMPE ITEM,CPOPJ        ;IF NONE, GO AWAY.
2622: PGCLR1: MOVEI TAC1,DISNOP       ;FREE A PIECE OF GLASS.
2623:         PUSHJ P,UPREL1          ;(SEE ABOVE.)
2624:         SOSL LSTPG(DDB)         ;HAVE WE GOT ALL THE PG'S ?
2625:         AOJA ITEM,PGCLR1        ;NO. GET SOME MORE.
2626:         MOVEI UCHN,DISNOP       ;TURN OFF CALL ON THE PG HEADER.
2627:         EXCH UCHN,PGCALL(DDB)
2628:         HLRZ AC1,UCHN           ;PTR. TO HEADER.
2629:         JRST CGIVFS             ;FREE THE PG HEADER BLOCK.
    DPYSER page# 0065 next  prev
2631: ; THIS UUO GETS INFORMATION FROM THE SYSTEM ABOUT THE USER'S PIECES
2632: ; OF GLASS. IT IS GIVEN IN A 17. WORD TABLE. THE FIRST WORD IS
2633: ; XWD <POG ACTIVE BITS>,<PP ACTIVE BITS> IN PPACT AND PGACT FORMAT.
2634: ; THE NEXT 16. WORDS, ONE WORD FOR EACH POG, IS XWD <WORD COUNT>,<STARTING ADDRESS>
2635: 
2636: PGINFO: MOVE AC1,PRGACT(DDB)    ; PICK UP THE ACTIVATION BITS
2637:         XCTR XW,[MOVEM AC1,(UUO)]
2638:         ADDI UUO,1
2639:         HLRZ AC1,PGCALL(DDB)    ; PICK UP ADDRESS OF UPG CONTROL BLOCK
2640:         SETZ AC3,
2641: PGCLP:  HLRZ CHR,(AC1)          ; PICK UP ADDRESS OF FIRST BLOCK OF CODE
2642:         JUMPE CHR,PGSZ          ; IF NOTHING THERE, CLEAR WORD IN TABLE
2643:         SUBI CHR,PGNP           ; POINT US TO THE CONTROL INFORMATION
2644:         HRRZ AC2,PGSA(CHR)      ; PICK UP THE STARTING ADDRESS
2645:         XCTR XRW,[HRRM AC2,(UUO)]
2646:         HRRZ AC1,PGWC(CHR)      ; AND THE WORD COUNT
2647:         XCTR XRW,[HRLM AC1,(UUO)]
2648:         JRST PGCNT
2649: 
2650: PGSZ:   XCTR XW,[SETZM (UUO)]
2651: PGCNT:  ADDI UUO,1              ; BUMP POINTER INTO USER'S TABLE
2652:         ADDI AC1,1              ; AND POINTER TO UPG CONTROL BLOCK
2653:         ADDI AC3,1              ; AND COUNT OF NUMBER OF POGS SEEN
2654:         CAIG AC3,LSTPG(DDB)     ; ARE WE PAST THE LAST?
2655:         JRST PGCLP              ; NO, LOOP BACK
2656: PGXLP:  CAILE AC3,17            ; ARE WE DONE?
2657:         POPJ P,                 ; YES, LEAVE
2658:         XCTR XW,[SETZM (UUO)]
2659:         ADDI AC3,1              ; AND COUNT
2660:         AOJA UUO,PGXLP          ; BUMP POINTER AND LOOP
2661: 
2662: BEND UPG
    DPYSER page# 0066 next  prev
2664: ;;DPYTYP IS CALLED AT CLOCK LEVEL TO TYPE SOME CHRS. FROM A 
2665: ;; TTY OUTPUT BUFFER ONTO A DISPLAY.  DAT CONTAINS LINE NUMBER.
2666: 
2667: DPYTY1: TRNE DAT,-1⊗PUNITS      ; LEGAL LINE NUMBER?
2668:         JRST DPYTER             ; NO, GIVE ERROR MESSAGE
2669:         SKIPN DDB,TTYTAB(DAT)   ; PICK UP DEVICE DATA BLOCK ADDRESS
2670:         POPJ P,                 ; IF NONE, LEAVE NOW, NO CHARACTERS TO TYPE
2671:         HRRZ TAC1,DAT           ; SAVE LINE NUMBER
2672: ↑DPYERT:
2673:         HRRI DAT,TTIBUF(DDB)    ; PICK UP INPUT BUFFER ADDRESS
2674:         HRLI DAT,DPYTY1         ; MAKE US COME BACK TO THIS ROUTINE IF WE HAVE TO WAIT
2675:         JRST DPYTY4
2676: 
2677: ↑DPYTYP: HGMAC(34)
2678:         TRNE DAT,-1⊗PUNITS
2679:         JRST DPYTER             ; ILLEGAL LINE NUMBER
2680:         HRLI DAT,DPYTYP         ; COME BACK TO HERE IF WE HAVE TO WAIT
2681:         SKIPN DDB,TTYTAB(DAT)   ; IS THERE A DDB THERE?
2682:         POPJ P,                 ; NO, NOT MUCH TO DO NOW!
2683:         HRRZ TAC1,DAT           ; SAVE LINE NUMBER
2684:         HRRI DAT,TTOBUF(DDB)    ; PICK UP OUTPUT BUFFER ADDRESS
2685: DPYTY4: MOVEI DSER,(DDB)        ;PRESERVE A COPY OF DDB ADDR.
2686:         HRRZ DDB,LETAB-DPYL0(TAC1)      ;FIND DPY FOR THIS JOB.
2687:         JUMPN DDB,DPYTY2        ; IF WE HAVE A BLOCK, OK
2688: DPYTY5: PUSHJ P,DPYMAKE         ; OTHERWISE, TRY TO MAKE ONE
2689:         JRST DPYTLN             ; NOONE HOME, LOSE LOSE
2690:         AOS NDPMAK#             ; BUMP NUMBER OF TIMES WE HAD TO DO THIS
2691:         HRRZ DDB,LETAB-DPYL0(TAC1)
2692: DPYTY2: MOVNI IOS,12            ;TYPE NO MORE THAN 12 CHARS/TICK.
2693:         SKIPE UUO,CURPP(DDB)    ;TYPE ON CURRENTLY SELECTED P OF P.
2694:         JRST DPYTL1
2695: DPYTY6: PUSH P,DAT              ; SAVE THE OUTPUT BUFFER ADDRESS
2696:         HLRE TAC,PRGNUM(DDB)    ; PICK UP DPY NUMBER
2697:         PUSHJ P,PPINIT          ; SEE IF WE CAN GET A PAGE PRINTER
2698:         JRST DPYTY3             ; NO, COME BACK NEXT TICK AND TRY AGAIN
2699:         PUSHJ P,PPSET           ; YES, INITIALIZE IT
2700:         HRRZ UUO,CURPP(DDB)     ; PICK UP ADDRESS OF PAGE PRINTER CONTROL BLOCK
2701:         POP P,DAT               ; GET BACK TTY OUTPUT BUFFER ADDRESS
2702:         JRST DPYTL1
2703: 
2704: DPYTY3: POP P,DAT
2705:         JRST DPYTLN
    DPYSER page# 0067 next  prev
2707: ; HERE WE ARE AT CLOCK LEVEL WITH (SUPPOSEDLY) DAT SET TO
2708: ; THE TTY BUFFER AND UUO POINTING TO THE PAGE PRINTER CONTROL BLOCK
2709: 
2710: DPYTL1: SKIPE PPDD(UUO)         ; IS THIS A DD DISPLAY?
2711:         TLO UUO,400000          ; YES, FLAG THIS TO DPYSER
2712:         SKIPE DPHOLD(DDB)       ; ARE WE IN HOLD MODE?
2713:         JRST STAR               ; YES, PRINT STARS AND GO AWAY
2714:         SKIPE PPENQ(UUO)        ; DO WE CURRENTLY HAVE ANYTHING IN THE QUEUE?
2715:         POPJ P,                 ; YES, GO AWAY UNTIL IT IS DONE.
2716: DPYTL2: CONO PI,SCNOFF          ; AVOID EMBARASSING CONFUSION OVER BUFFER EMPTY
2717: DPTL2A: PUSHJ P,GETCHO          ; GET A CHARACTER
2718:         JUMPE CHR,DPYTLX        ; BUFFER EMPTY
2719: 
2720:         SKIPL   LSTCHR(UUO)     ;REG 1/25/74 DID TYO INVENT CRLF LAST TIME?
2721:         JRST    DPTL2B          ;NO. BEHAVE NORMALLY
2722:         CAIN    CHR,15          ;YES. CR'S GET FLUSHED NOW.
2723:         JRST    DPTL2A          ;
2724:         MOVEM   CHR,LSTCHR(UUO) ;SAVE CHR
2725:         MOVEI   CHR,12
2726:         EXCH    CHR,LSTCHR(UUO) ;RESTORE CHR. LSTCHR NOW LOOKS LIKE NORMAL LF.
2727:         CAIN    CHR,12          ;FIRST LF AFTER LSTCHR WAS SET TO -1 IS FLUSHED.
2728:         JRST    DPTL2A          ;ONLY IF NO PREVIOUS CHARACTER (EXCEPT CR) SEEN
2729: 
2730: DPTL2B: PUSH P,CHR              ; SAVE THE CHARACTER
2731:         EXCH DAT,UUO            ; GET PP CONTROL BLOCK ADDRESS IN DAT
2732:         PUSHJ P,TYO             ; SEND THE CHARACTER OUT
2733:         CONO PI,SCNON
2734:         EXCH DAT,UUO
2735:         POP P,CHR
2736: 
2737:         SKIPGE LSTCHR(UUO)      ;DID TYO INVENT CRLF AT LONG LINE?  REG 1/25/74
2738:         MOVEI CHR,12            ;YES. PRETEND WE WERE THE ONE WHO ASKED FOR LF.
2739: 
2740:         CAIN CHR,12             ; IS IT END OF LINE TIME?
2741:         SOSE LHCNT(DDB)         ; YES, ARE WE SUPPOSED TO HOLD NOW?
2742:         JRST DPYTL3             ; NO, GO ON
2743:         LDB AC1,HLINES          ; YES, RESET HOLD COUNT
2744:         MOVEM AC1,LHCNT(DDB)
2745:         SETOM DPHOLD(DDB)
2746:         JRST STAR
2747: 
2748: DPYTL3: SKIPE GLTCH(UUO)        ; GLITCH TIME?
2749:         SKIPE GLHCNT(DDB)       ; YES, IS IT TIME TO HOLD?
2750:         JRST DPYTL4
2751:         LDB AC1,HGLTCH          ; YES, RESET COUNT
2752:         MOVEM AC1,GLHCNT(DDB)
2753:         SETOM DPHOLD(DDB)
2754:         JRST STAR
2755: 
2756: DPYTL4: JUMPL UUO,DPTDD         ; IF DD, GO TO SPECIAL ROUTINE
2757: ;*** RPH PATCH TO SLOW DOWN OUTPUT OF BLANK LINES
2758:         CAIE CHR,12
2759:         CAIN CHR,15
2760:         JRST DPYTLN
2761: ;*** END SLOW DOWN PATCH
2762:         AOJN IOS,DPYTL2         ; OTHERWISE, COUNT DOWN AND LOOP BACK
2763:         JRST DPYTLN             ; AND PUT IN ANOTHER CLOCK REQUEST IF TOO MANY CHARACTERS THIS TICK
    DPYSER page# 0068 next  prev
2765: ; ROUTINE TO TYPE CTY ERROR MESSAGE ON ILLEGAL LINE NUMBER
2766: 
2767: DPYTER: PUSH P,DAT
2768:         PUSHJ P,DISERR
2769:         [ASCIZ /ILLEGAL LINE NUMBER AT DPYTYP - /]
2770:         DISARG OCT,<-1(P)>
2771:         [ASCIZ /
2772: /]
2773:         -1
2774:         POP P,DAT
2775:         POPJ P,
2776: 
2777: ; ROUTINE TO TYPE STAR ON LINE THREE WHEN TYPEOUT IS HELD UP
2778: 
2779: STAR:   JUMPG UUO,IISTAR        ; SEPARATE ROUTINE FOR III
2780:         PUSHJ P,GETQ            ; GET A TASK BLOCK
2781:         PUSH P,AC1              ; SAVE ITS ADDRESS
2782:         PUSHJ P,GETQ            ; PICK UP ONE FOR THE OTHER FIELD
2783:         MOVE AC2,(P)            ; GET THE ADDRESS OF THE FIRST ONE BACK
2784:         HRLI UUO,PPSTAR         ; SET UP DISPATCH TO ROUTINE THAT DRAWS STAR ON LINE THREE
2785:         MOVSM UUO,(AC1)         ; SET IT IN FIRST TASK BLOCK
2786:         MOVSM UUO,(AC2)         ; AND IN SECOND ONE
2787:         SETZM QCOUNT(AC1)       ; DON'T WAKE ANYBODY UP ABOUT THIS
2788:         SETZM QCOUNT(AC2)
2789:         SETZM QFIELD(AC1)       ; FIRST FIELD OF ERASURE
2790:         SETOM QFIELD(AC2)       ; SECOND FIELD
2791:         MOVE AC3,[XWD 3,3]      ; TELL QBLOCK WHERE TO QUEUE THIS REQUEST
2792:         MOVEM AC3,QLINE(AC1)
2793:         MOVEM AC3,QLINE(AC2)
2794:         PUSHJ P,QBLOCK          ; NOW QUEUE UP THE REQUESTS
2795:         POP P,AC1
2796:         JRST QBLOCK
2797: 
2798: IISTAR: MOVE AC1,PSELB(DDB)     ; PICK UP GUY'S SELECT WORD
2799:         AND AC1,[77B5]          ; MASK OUT ALL BUT HIS SELECT BIT
2800:         ORM AC1,DPYHLD          ; SELECT HIM FOR THE MASSAGE
2801:         LSH AC1,-=12            ; MOVE OVER TO DESELECT FIELD
2802:         ANDCAM AC1,DPYHLD
2803:         POPJ P,
    DPYSER page# 0069 next  prev
2805: ; ROUTINE, CALLED FROM CLOCK CALL WITH LINE NUMBER IN DAT, TO CONTINUE PAGE PRINTER
2806: 
2807: ↑UNHOLD:
2808:         HRLI DAT,DPYTYP         ; SET UP TO COME BACK TO PRINT ROUTINE IF DONE
2809:         TRNE DAT,-1⊗PUNITS      ; IS THE LINE NUMBER LEGAL?
2810:         JRST DPYTER             ; NO, TYPE MESSAGE
2811:         SKIPN DDB,TTYTAB(DAT)   ; IS THERE A TTY DDB?
2812:         POPJ P,                 ; NO, FORGET IT.
2813:         HRRZ TAC1,DAT           ; SAVE LINE NUMBER
2814:         HRRI DAT,TTOBUF(DDB)    ; PICK UP OUTPUT BUFFER ADDRESS
2815:         MOVEI DSER,(DDB)        ; COPY THE DEVICE DATA BLOCK POINTER
2816:         HRRZ DDB,LETAB-DPYL0(TAC1)
2817:         JUMPE DDB,DPYTY4        ; IF NO PROGRAM HEADER, NO STAR TO ERASE
2818:         SKIPN UUO,CURPP(DDB)    ; GET ADDRESS OF PAGE PRINTER CONTROL BLOCK
2819:         JRST DPYTY6             ; IF NONE, GO MAKE ONE UP
2820:         SKIPE PPDD(UUO)
2821:         TLO DDB,400000
2822:         HLL UUO,DDB
2823:         JUMPG UUO,UNHIII
2824:         PUSHJ P,GETQ            ; GET A TASK BLOCK
2825:         PUSH P,AC1              ; SAVE ITS ADDRESS
2826:         PUSHJ P,GETQ            ; GET ANOTHER ONE FOR THE OTHER FIELD
2827:         MOVE AC2,(P)            ; PICK UP ADDRESS OF FIRST ONE
2828:         SETZM QFIELD(AC1)       ; SEND IT OUT ON ONE FIELD
2829:         SETOM QFIELD(AC2)       ; THE OTHER ON THE OTHER
2830:         HRLI UUO,ERASE          ; DISPATCH TO THE ERASURE ROUTINE
2831:         MOVSM UUO,(AC1)         ; SET THAT IN DISPATCH ADDRESS
2832:         MOVSM UUO,(AC2)
2833:         SETZM QCOUNT(AC1)       ; DON'T WAKE ANYBODY UP
2834:         SETZM QCOUNT(AC2)
2835:         MOVE AC3,[XWD 3,3]      ; ERASE LINE 3
2836:         MOVEM AC3,QLINE(AC1)
2837:         MOVEM AC3,QLINE(AC2)
2838:         PUSHJ P,QBLOCK
2839:         POP P,AC1
2840:         PUSHJ P,QBLOCK
2841:         HRLI UUO,400000         ; RESTORE DD FLAG
2842:         JRST DPYTL1
2843: 
2844: UNHIII: MOVE AC1,PSELB(DDB)
2845:         AND AC1,[77B5]
2846:         ANDCAM AC1,DPYHLD
2847:         LSH AC1,-=12
2848:         ORM AC1,DPYHLD
2849:         JRST DPYTL1
    DPYSER page# 0070 next  prev
2851: ; COME HERE FOR DATA DISK TO SEE IF IT IS END OF LINE OR GLITCH TIME.
2852: 
2853: DPTDD:  SKIPN GLTCH(UUO)        ; HAS THE PAGE PRINTER GLITCHED?
2854:         CAIN CHR,12             ; OR IS THIS END OF LINE?
2855:         JRST DPTDDK             ; YES, QUEUE UP A DD REQUEST AND LEAVE
2856:         JRST DPYTL2             ; OTHERWISE, PUT IN ANOTHER CHARACTER
2857: 
2858: DPTDDK: HRRZ AC1,TPJMP(UUO)     ; FIRST, IS THE P OF P ACTIVE?
2859:         CAIN AC1,DISNOP
2860:         JRST DPYTL2             ; NO, JUST EMPTY THE BUFFER
2861:         JRST QDDR
2862: 
2863: DPYTLN: HRR DAT,TAC1            ; PUT IN LINE NUMBER AS DATUM
2864: ↑DPYTIM:CONO PI,PIOFF
2865:         IDPB DAT,CLKQ           ;PUT IN CLOCK REQUEST.
2866:         CONO PI,PION
2867:         POPJ P,
    DPYSER page# 0071 next  prev
2869: SUBTTL DATA DISK SERVICE ROUTINE - JAM, DEC. 1970
2870: 
2871: ; THESE ROUTINES ARE CALLED BY THE FOLLOWING IN APRINT
2872: ;       SOSGE DDCNT
2873: ;       JRST DDCLK
2874: ;       SKIPE DDSTART
2875: ;       JRST DDSTRT
2876: ;APRADD:
2877: ; THE DATA DISK ROUTINES KNOW ALL ABOUT THE PAGE PRINTER
2878: ; AND THE PIECE OF GLASS MECHANISM. TRANSFERS ARE STARTED
2879: ; BY PLACING AN ADDRESS IN THE QUEUE WITH THE LEFT HALF GIVING
2880: ; THE TYPE OF TRANSFER.
2881: 
2882: ; HERE ARE THE DD HARDWARE BITS
2883: ; CONO BITS
2884: 
2885: START←←100      ; STARTS TRANSFER
2886: RESET←←10       ; RESETS INTERRUPT BIT
2887: ENB←←40         ; INTERRUPT ENABLE
2888: LOSENB←←400     ; ENABLE LATE FLAG INTERRUP
2889: DAMMIT←←20      ; MAKES TRANSFER GO OUT ON SPECIFIC FIELD
2890: EXECM←←1000     ; EXEC MODE, ALLOWS ONLY ONE CHANNEL SELECT
2891: DDNXM←←2000     ; NON-EX MEM FLAG
2892: USUAL←←START!ENB!LOSENB!DAMMIT!APRCHN
2893: 
2894: ; CONI BITS
2895: FIELD←←40       ; FIELD BIT
2896: INT←←20         ; INTERRUPT BIT
2897: LOSE←←200       ; LATE FLAG
2898: 
2899: ; $M+2/     -1775,,770707
2900: 
2901: ; TASKS ARE QUEUED UP IN SMALL BLOCKS IN THE FOLLOWING FORM:
2902: 
2903:                 ; FIRST WORD CONTAINS XWD <RELEVANT DATA BLOCK>,<ROUTINE>
2904: QLINE←←1        ; XWD <STARTING LINE #>,<ENDING LINE #>
2905: QFIELD←←2       ; 0 FOR EVEN FIELD, -1 FOR ODD FIELD
2906: QHPOS←←3        ; XWD <HPOS1>,<HPOS2> FOR CURSOR TRANSFERS. ZERO ERASES CURSORS.
2907: QLINK←←4        ; LINKAGE WORD. XWD <BACKWARD LINK OR 0>,<FORWARD LINK OR 0>
2908: QWAKE←←5        ; CONTAINS JOB NUMBER TO WAKE UP, OR CLOCK REQUEST TO PLANT
2909: QCOUNT←←6       ; ADDRESS OF WORD TO DECREMENT WHEN THIS TASK DONE. WHEN ZERO, WAKE UP VIA QWAKE WHOMEVER
2910: QTIME←←7        ; COUNT DOWN OF NUMBER OF FAILURES
2911: ↑QLENGTH←←10    ; LENGTH OF A TASK BLOCK
    DPYSER page# 0072 next  prev
2913: ; CLOCK LEVEL QUEING SCHEME. PLANTS TASKS IN QUEUE AND LEAVES.
2914: ; LAST TASK TO FINISH PLANTS CLOCK REQUEST TO TRANSFER MORE DATA.
2915: 
2916: QDDR:   MOVE AC3,VPOS(UUO)      ; PICK UP VERTICAL POSITION
2917:         SUBI AC3,1              ; DON'T GO ALL THE WAY TO THE CURRENT LINE
2918:         MOVEM AC3,VP(UUO)       ; STORE IT
2919:         PUSHJ P,GETQ            ; GET A TASK BLOCK
2920:         PUSH P,AC1              ; SAVE ADDRESS OF FIRST TASK BLOCK
2921:         PUSHJ P,GETQ            ; GET ANOTHER TASK BLOCK
2922:         MOVE AC2,(P)            ; PICK UP ADDRESS OF FIRST TASK BLOCK TOO
2923:         HRR DAT,TAC1            ; PUT IN LINE NUMBER AS DATUM OF CLOCK REQUEST
2924:         MOVEM DAT,QWAKE(AC1)    ; PUT THE OUTPUT BUFFER ADDRESS AS WAKEUP WORD
2925:         MOVEM DAT,QWAKE(AC2)
2926:         AOS PPENQ(UUO)          ; BUMP TASK COUNT BY TWO
2927:         AOS PPENQ(UUO)
2928:         MOVEI AC3,PPENQ(UUO)    ; COUNT US DOWN ON THE PAGE PRINTER COUNTER
2929: DOXFR:  SETZM PPVIRG(UUO)       ; NOTE THAT SOMETHING HAS GONE OUT ON THIS PIECE OF PAPER
2930:         MOVEM AC3,SC(UUO)       ; SAVE THE COUNT ADDRESS, IF ANY, FOR FUTURE REFERENCE
2931:         MOVEM AC3,QCOUNT(AC1)
2932:         MOVEM AC3,QCOUNT(AC2)
2933:         SETZM QFIELD(AC1)       ; SEND ONE OUT ON ONE FIELD
2934:         SETOM QFIELD(AC2)       ; AND THE OTHER OUT ON THE OTHER
2935:         HRLM UUO,(AC1)
2936:         HRLM UUO,(AC2)          ; SAVE PAGE PRINTER CONTROL BLOCK ADDRESS AS DATA BLOCK ADDRESS
2937:         MOVEI AC3,PPXFR         ; PICK UP ADDRESS OF I-LEVEL SUBROUTINE
2938:         HRRM AC3,(AC1)          ; PLACE IT IN ROUTINE ADDRESS POSITION
2939:         HRRM AC3,(AC2)
2940:         SKIPN GLTCH(UUO)        ; IS THIS A WHOLE SCREEN TRANSFER?
2941:         JRST DPTDL              ; NO, JUST DO ONE LINE
2942:         SETZM GLTCH(UUO)        ; WE ARE DONE GLITCHING
2943:         EXCH DAT,UUO            ; PICK UP PAGE PRINTER CONTROL BLOCK ADDRESS
2944:         PUSHJ P,POSLIN          ; GET LINE NUMBER OF FIRST LINE OF TRANSFER
2945:         EXCH DAT,UUO
2946:         CAML AC3,VPOS(UUO)      ; IS THERE REALLY A PAGE HERE?
2947:         JRST NOPAGE             ; NO!
2948:         HRLM AC3,QLINE(AC1)
2949:         HRLM AC3,QLINE(AC2)     ; THAT WILL BE STARTING LINE NUMBER ON BOTH FIELDS
2950:         MOVE AC3,VP(UUO)        ; PICK UP NUMBER OF LAST LINE OF TRANSFER
2951:         HRRM AC3,QLINE(AC1)     ; THIS WILL BE ENDING LINE NUMBER
2952:         HRRM AC3,QLINE(AC2)
2953:         PUSHJ P,QBLOCK          ; QUEUE UP FIRST TASK
2954:         POP P,AC1               ; GET ADDRESS OF SECOND TASK BACK
2955:         PUSHJ P,QBLOCK          ; QUEUE IT UP
    DPYSER page# 0073 next  prev
2957: ; WE GET HERE AT CLOCK LEVEL IN THE MIDDLE OF QUEUEING UP A WHOLE SCREEN REQUEST.
2958: ; WE HAVE PUT IN THE TEXT REQUESTS AND ARE NOW GOING TO PUT IN THE ERASURE
2959: ; REQUEST.
2960: 
2961:         MOVE AC2,VP(UUO)        ; FIRST, IS THERE ANYTHING TO DO?
2962:         MOVEM AC2,LLW(UUO)      ; UPDATE LAST LINE WRITTEN
2963:         CAML AC2,GLW(UUO)
2964:         POPJ P,                 ; NO, WE ARE DONE
2965:         PUSHJ P,GETQ
2966:         PUSH P,AC1              ; GET ANOTHER TASK BLOCK AND SAVE ITS ADDRESS
2967:         PUSHJ P,GETQ            ; GET ONE FOR EACH ERASURE FIELD
2968:         MOVE AC3,(P)            ; GET BACK ADDRESS OF FIRST ONE
2969:         HRLM UUO,(AC1)          ; PUT IN PAGE PRINTER CONTROL BLOCK ADDRESS
2970:         HRLM UUO,(AC3)
2971:         MOVEI AC2,ERASE         ; WE WILL CALL THE ERASE CODE
2972:         HRRM AC2,(AC1)
2973:         HRRM AC2,(AC3)
2974:         MOVEM DAT,QWAKE(AC1)    ; PUT THE CLOCK REQUEST WORD IN
2975:         MOVEM DAT,QWAKE(AC3)
2976:         MOVE AC2,SC(UUO)        ; PICK UP COUNT ADDRESS
2977:         MOVEM AC2,QCOUNT(AC1)   ; COUNT DOWN THROUGH IT.
2978:         MOVEM AC2,QCOUNT(AC3)
2979:         SETZM QFIELD(AC1)       ; SEND THEM OUT ON OPPOSITE FIELDS
2980:         SETOM QFIELD(AC3)
2981:         MOVE AC2,GLW(UUO)       ; ERASE TO THE LAST LINE WRITTEN
2982:         HRRM AC2,QLINE(AC1)
2983:         HRRM AC2,QLINE(AC3)
2984:         MOVE AC2,VP(UUO)        ; ERASE FROM THE CURRENT POSITION
2985:         MOVEM AC2,GLW(UUO)      ; UPDATE LAST LINE WRITTEN
2986:         HRLM AC2,QLINE(AC1)
2987:         HRLM AC2,QLINE(AC3)
2988:         SKIPN SC(UUO)           ; IS THERE A COUNT ADDRESS?
2989:         JRST QDD1               ; NO, DON'T INCREMENT IT!
2990:         AOS @SC(UUO)            ; YES, BUMP IT TWICE
2991:         AOS @SC(UUO)
2992: QDD1:   PUSHJ P,QBLOCK          ; QUEUE UP THE FIRST ONE
2993:         POP P,AC1
2994:         JRST QBLOCK             ; AND THE SECOND ONE
2995: 
2996: ; WE GET HERE IF THERE REALLY ISN'T ANYTHING ON THE PAGE
2997: 
2998: NOPAGE: PUSHJ P,WAKEQ           ; WAKE UP ANYONE WHO'S THERE
2999:         PUSHJ P,GIVQB           ; JUST RETURN EVERYTHING TO FREE STORAGE.
3000:         POP P,AC1
3001:         PUSHJ P,WAKEQ
3002:         JRST GIVQB
    DPYSER page# 0074 next  prev
3004: ; WE GET HERE TO QUEUE UP A ONE LINE REQUEST.
3005: 
3006: DPTDL:  MOVE AC3,LLW(UUO)       ; PICK UP LINE NUMBER
3007:         CAMLE AC3,VP(UUO)       ; IS THIS PAST WHERE WE ARE SUPPOSED TO BE?
3008:         MOVE AC3,VP(UUO)        ; YES, USE OUR ARGUEMENT
3009:         HRLM AC3,QLINE(AC1)     ; STORE THIS
3010:         HRLM AC3,QLINE(AC2)
3011:         MOVE AC3,VP(UUO)        ; END UP ON LINE THE CALLER REQUESTED
3012:         HRRM AC3,QLINE(AC1)
3013:         HRRM AC3,QLINE(AC2)
3014:         MOVEM AC3,LLW(UUO)      ; AND THIS IS NOW THE LAST LINE WRITTEN
3015:         PUSHJ P,QBLOCK          ; PUT THIS BLOCK IN THE QUEUE
3016:         POP P,AC1               ; GET BACK ADDRESS OF SECOND BLOCK
3017:         JRST QBLOCK             ; QUEUE IT UP TOO
3018: 
3019: ; WE GET TO THIS ROUTINE WHEN THE BUFFER IS EMPTY.
3020: 
3021: DPYTLX: JUMPG UUO,DPYDON        ; III DISPLAYS CAN GO ON TO TTYSER NOW
3022:         SKIPN DPYCHR(UUO)       ; HAS AT LEAST ONE CHARACTER BEEN TYPED?
3023:         JRST DPYDON             ; NO, EXIT
3024:         SETZM DPYCHR(UUO)       ; CLEAR TYPEOUT FLAG
3025:         MOVN AC1,DPHPOS(UUO)    ; PICK UP HORIZONTAL POSITION POINTER
3026:         PUSH P,DAT              ; SAVE TTY BUFFER ADDRESS
3027:         HRR DAT,UUO             ; PUT PAGE PRINTER CONTROL BLOCK ADDRESS IN DAT FOR REFLINE
3028:         MOVE AC2,LLW(UUO)       ; SEE IF PAGE PRINTER IS UP TO DATE
3029:         CAMN AC2,VPOS(UUO)      ; COMPARE LAST LINE WRITTEN WITH VERTICAL POSITION
3030:         CAME AC1,LNLNGT(UUO)    ; IF NOT AT COLUMN ZERO,
3031:         PUSHJ P,REFLINE         ; PUT IN A SINGLE LINE REQUEST
3032:         POP P,DAT
3033:         HRRZ AC1,HEDPTR(UUO)    ; PICK UP POINTER TO DPY PROGRAM HEADER
3034:         MOVSI AC2,DPLED         ; MAKE A POINTER TO THE LINE EDITOR QUEUE ROUTINE
3035:         HRR AC2,AC1             ; AND MAKE IT INTO A CLOCK REQUEST WORD
3036:         SETO AC3,               ; SEE IF LINE EDITOR CLOCK FLAG IS SET
3037:         EXCH AC3,LECLK(AC1)     ; IF NOT SET, SET IT NOW
3038:         JUMPL AC3,DPYDON        ; IF ALREADY IN, LEAVE NOW
3039:         CONO PI,PIOFF           ; NOT IN, PLANT CLOCK REQUEST
3040:         IDPB AC2,CLKQ
3041:         CONO PI,PION
3042:         JRST DPYDON
    DPYSER page# 0075 next  prev
3044: ; THIS ROUTINE QUEUES UP AN ERASURE REQUEST FOR THE LINE EDITOR <ESC>C COMMAND
3045: 
3046: ↑LEERSN:TLCA DAT,LEERSN≠PPNSET  ;CHANGE CLK RQ TO CALL PPNSET
3047: ↑RFPCS: HRLI DAT,LERFP
3048:         SKIPE III(DAT)
3049:         JRST LEPGC
3050:         MOVEI AC2,LEENQ2(DAT)   ;ENTER HERE FOR SOMETHING ELSE TO BE QUEUED AFTER THE ERASE
3051:         AOSA LEENQ2(DAT)
3052: ↑LEERS: MOVEI AC2,
3053:         SKIPE III(DAT)
3054:         JRST LEPGC2             ;DIFFERENT "ERASE" ON III
3055:         PUSHJ P,GETQ            ; GET A TASK BLOCK
3056:         MOVEM AC2,QCOUNT(AC1)
3057:         MOVEM DAT,QWAKE(AC1)
3058:         SETOM LECC(DAT)
3059: LEERS3: MOVE AC2,[XWD 1,=40]
3060:         MOVEM AC2,QLINE(AC1)
3061:         SETZM QFIELD(AC1)       ; START ON FIELD ZERO
3062:         HRLM DAT,(AC1)          ; GIVE IT DPY PROGRAM HEADER ADDRESS
3063:         MOVEI AC2,WSE           ; GO TO THE ERASURE ROUTINE
3064:         HRRM AC2,(AC1)
3065:         SETOM LEVP(DAT)         ;TELL DPLED OUR CURSORS BIT THE DUST
3066:         SETOM LECVP(DAT)
3067:         JRST QBLOCK             ; PUT IT IN THE QUEUE
3068: 
3069: LEPGC:  HLRZ TAC,DAT
3070:         PUSH P,DAT
3071:         PUSHJ P,(TAC)           ;DO PP STUFF FIRST
3072:         POP P,DAT
3073: LEPGC2: MOVEI DDB,(DAT)
3074:         JRST PGCLR
3075: 
3076: ; THE LINE EDITOR PLANTS A CLOCK REQUEST TO HERE WHEN IT
3077: ; IS DONE TRANSFERRING A LINE INTO THE PAGE PRINTER BUFFER.
3078: ; WE SEND OUT THE LINE IT HAS JUST TRANSFERRED.
3079: 
3080: ↑REFLINE:
3081:         HRRZ AC1,TPJMP(DAT)     ; PICK UP JUMP TO TEXT
3082:         CAIN AC1,DISNOP         ; IS IT REALLY A JUMP?
3083:         POPJ P,                 ; NO, DON'T BOTHER
3084:         PUSHJ P,GETQ            ; GET US A TASK BLOCK
3085:         PUSH P,AC1
3086:         PUSHJ P,GETQ
3087:         MOVE AC2,(P)
3088:         MOVE AC3,VPOS(DAT)      ; PICK UP VERTICAL POSITION
3089:         MOVEM AC3,VP(DAT)       ; SAVE THIS AS ARGUEMENT FOR QDD
3090:         MOVEI AC3,PPNQT(DAT)    ; COUNT DOWN THROUGH OTHER COUNT CELL
3091:         HRRZ UUO,DAT            ; IT EXPECTS THE PAGE PRINTER ADDRESS IN UUO
3092:         AOS PPNQT(DAT)          ; COUNT DOWN SO THE LINE EDITOR WILL KNOW WHEN WE ARE DONE
3093:         AOS PPNQT(DAT)
3094:         SETZM QWAKE(AC1)        ; DON'T WAKE UP ANYBODY
3095:         SETZB DAT,QWAKE(AC2)
3096:         JRST DOXFR              ; USE QDD TO DO ALL THIS
    DPYSER page# 0076 next  prev
3098: ; HERE LIES A ROUTINE TO QUEUE UP A WHOLE PAGE TRANSFER WHEN NOT GLITCHING
3099: 
3100: ↑LERFP: MOVEI DDB,(DAT)
3101:         SKIPE III(DAT)
3102:         JRST PPRST              ;RESTART PROG IF III
3103:         HRRZ UUO,CURPP(DAT)     ; PICK UP PAGE PRINTER CONTROL BLOCK ADDRESS
3104:         MOVE AC1,HEDPTR(UUO)
3105:         CAIE AC1,(DAT)
3106:         JRST PPCLB              ;CURPP IS CLOBBERED OR SOMETHING
3107:         HRRZ AC1,TPJMP(UUO)     ; PICK UP JUMP TO TEXT
3108:         CAIN AC1,DISNOP         ; IS IT REALLY A JUMP?
3109:         POPJ P,                 ; NO, FORGET IT
3110:         SKIPE PPENQ(UUO)        ; IS THERE ANYTHING IN THE PAGE PRINTER'S QUEUE?
3111:         JRST LERFP1             ; YES, IT WILL GET CAUGHT LATER
3112:         SETZM PPVIRG(UUO)       ; NO LONGER A VIRGIN PIECE OF PAPER
3113:         JSP AC3,GET2Q
3114:         MOVEI AC3,LEENQ2(DAT)
3115:         MOVEM AC3,QCOUNT(AC1)
3116:         MOVEM AC3,QCOUNT(AC2)
3117:         MOVEI AC3,2
3118:         ADDM AC3,LEENQ2(DAT)
3119:         HRR AC3,DAT
3120:         HRLI AC3,LERELE
3121:         MOVEM AC3,QWAKE(AC1)
3122:         MOVEM AC3,QWAKE(AC2)
3123:         HRLM UUO,(AC1)          ; PUT IN ADDRESS OF PAGE PRINTER CONTROL BLOCK
3124:         HRLM UUO,(AC2)
3125:         MOVEI AC3,PPXFR         ; THE I-LEVEL SUBROUTINE ADDRESS
3126:         HRRM AC3,(AC1)
3127:         HRRM AC3,(AC2)
3128:         EXCH DAT,UUO            ; PICK UP THE NUMBER OF THE LINE AT THE TOP OF THE PAGE
3129:         PUSHJ P,POSLIN
3130:         EXCH DAT,UUO
3131:         HRLM AC3,QLINE(AC1)     ; PUT IN THAT AS OUR STARTING LINE NUMBER
3132:         HRLM AC3,QLINE(AC2)
3133:         MOVE AC3,VPOS(UUO)      ; PICK UP THE CURRENT POSITION OF THE BOTTOM OF THE PAGE
3134:         HRRM AC3,QLINE(AC1)
3135:         HRRM AC3,QLINE(AC2)
3136: Q2BLCK: PUSHJ P,QBLOCK          ; QUEUE THEM UP
3137:         POP P,AC1
3138:         JRST QBLOCK             ; QUEUE UP THE LAST TASK AND LEAVE
3139: 
3140: LERFP1: SETOM GLTCH(UUO)        ; FORCE THE PAGE PRINTER TO REFRESH NEXT TIME AROUND
3141:         POPJ P,
3142: 
3143: GET2Q:  
3144:         PUSHJ P,GETQ            ; OTHERWISE, GET A TASK BLOCK TO DO IT OURSELVES
3145:         PUSH P,AC1
3146:         PUSHJ P,GETQ
3147:         HRRZ AC2,(P)
3148:         SETZM QFIELD(AC1)       ; SEND THESE OUT ON OPPOSITE FIELDS
3149:         SETOM QFIELD(AC2)
3150:         JRST @AC3
3151: 
3152: LERELE:         ;REFRESH LINE EDITOR
3153:         EXCH DAT,ITEM
3154:         PUSHJ P,QLETXT          ;QLETXT IS IN LINED
3155:         EXCH DAT,ITEM
3156:         POPJ P,
3157: 
3158: PPCLB:  PUSHACS
3159:         PUSHJ P,DISDAT
3160:         PUSHJ P,DISMES
3161:         ASCIZ /CURPP CLOBBERED AT LERELE
3162: /
3163:         DEBCHE
3164:         POPACS
3165:         POPJ P,
    DPYSER page# 0077 next  prev
3167: ; HERE IS THE MIGHTY LINE EDITOR AND CURSOR GENERATOR.
3168: ; THIS ROUTINE SINGLEHANDEDLY SENDS OUT LINE EDITOR TRANSFERS, LINE EDITOR
3169: ; ERASURES, ALL CURSORS AND ALL CURSOR ERASURES.
3170: 
3171: ↑DPLED: HGMAC(33)
3172:         SKIPE LEENQ(DAT)        ; DO WE HAVE SOMETHING IN THE QUEUE ALREAD
3173:         POPJ P,                 ; YES, THIS ISN'T SUPPOSED TO HAPPEN!
3174:         HRRZ UUO,CURPP(DAT)     ; PICK UP ADDRESS OF PAGE PRINTER CONTROL BLOCK
3175:         SKIPE PPENQ(UUO)        ; IS THERE ANYTHING IN THE PAGE PRINTER QUEUE?
3176:         JRST DPYTIM             ; YES, COME BACK LATER
3177:         CONO PI,SCNOFF          ;FREEZE EVERYTHING
3178:         MOVE AC1,VPOS(UUO)      ; ASSUME WE ARE GOING IN THE USUAL POSITION
3179:         MOVEM AC1,LELINE(DAT)
3180:         MOVE AC1,DPHPOS(UUO)
3181:         ADD AC1,LNLNGT(UUO)
3182:         MOVEM AC1,PPHPOS(DAT)   ;INITIALLY ASSUME LINE EDITOR X = PP X
3183:         SKIPL AC3,LEPOS(DAT)
3184:         JRST DPLEVS
3185:         LDB AC3,[POINT 11,AC3,21]
3186:         TRNE AC3,1⊗=10          ; EXTEND SIGN BIT
3187:         OR AC3,[-1⊗=10]
3188:         PUSHJ P,POSLI2
3189:         MOVEM AC3,LELINE(DAT)
3190:         SETZB AC1,PPHPOS(DAT)   ;NOW LINE EDITOR X IS ALWAYS ZERO
3191: DPLEVS: MOVEI AC3,LEENQ(DAT)    ; GET ADDRESS OF COUNT WORD
3192:         MOVEM AC3,SC(UUO)       ; USE IT TO COUNT DOWN OUR TASKS
3193:         MOVE AC3,PRGNUM(DAT)    ; PICK UP DPY NUMBER
3194:         SKIPG J,LETAB(AC3)      ; IS THE LINE EDITOR CURRENTLY INITIALIZED??
3195:         JRST DPLGCP             ; YES, GET ITS POSITION FROM THE CHARACTER COUNT
    DPYSER page# 0078 next  prev
3197: ; HERE WE SET UP THE CURSOR POSITION AND START ON THE DECISION TREE
3198: 
3199: DPLGC2: MOVEM AC1,CHP(DAT)      ; SAVE THE HORIZONTAL POSITION
3200:         MOVE AC1,LELINE(DAT)
3201: DPLGC1: MOVEM AC1,CVP(DAT)      ; AND THE VERTICAL POSITION
3202:         MOVE AC1,LELINE(DAT)    ; GET VERTICAL POSITION
3203:         CAMN AC1,LEVP(DAT)      ; HAS THE VERTICAL POSITION OF THE LINE EDITOR CHANGED?
3204:         JRST DPTLE1             ; NO, SEE IF ANYTHING ELSE HAS CHANGED.
3205:         PUSHJ P,DPEC            ; ERASE THE LINE EDITOR CURSOR
3206:         PUSHJ P,DPEOPC          ; ERASE THE PAGE PRINTER CURSOR
3207:         PUSHJ P,DPWT            ; WRITE OUT THE TEXT AGAIN.
3208:         MOVE AC1,CVP(DAT)       ; PICK UP CURSOR POSITION
3209:         CAMN AC1,LELINE(DAT)    ; IS IT THE SAME AS THE PAGE PRINTER POSITION?
3210:         JRST DPTL14             ; YES, WRITE OUT BOTH CURSORS ON THE SAME LINE
3211:         PUSHJ P,DPWC            ; NO, WRITE OUT THE LINE EDITOR CURSOR
3212:         PUSHJ P,DPWPC           ; THEN WRITE OUT THE PAGE PRINTER CURSOR
3213:         JRST DPTLE5             ; GO UPDATE STATE OF HISTORY TO REFLECT OUR TRANSFERS.
3214: 
3215: DPTL14: PUSHJ P,DPWB            ; SAME LINE, WRITE OUT BOTH CURSORS AT ONCE
3216:         JRST DPTLE5
3217: 
3218: DPLGCP: ADD AC1,LEHPOS(DAT)     ; ADD IN LINE EDITOR CURSOR HORIZONTAL POSITION
3219:         JUMPE AC1,DPLGC2        ; IF NO DISTANCE INTO LINE, SET POSITIONS TO ZERO
3220:         IDIV AC1,LNLNGT(UUO)    ; CONVERT TO NUMBER OF LINES AND DISPLACEMENT INTO LAST LINE
3221:         ADD AC1,LELINE(DAT)     ; ADD IN STARTING LINE NUMBER
3222:         MOVEM AC2,CHP(DAT)      ; THE REMAINDER IS THE HORIZONTAL POSITION
3223:         JRST DPLGC1             ; AND WE NOW HAVE IT ALL!
    DPYSER page# 0079 next  prev
3225: ; WE GET HERE IF THE VERTICAL POSITION OF THE LINE EDITOR HAS NOT CHANGED.
3226: ; WE CHECK IF ANYTHING ELSE ABOUT THE LINE MIGHT HAVE CHANGED.
3227: 
3228: DPTLE1: JUMPGE J,DPTL1A         ;DON'T BOTHER CHECKING EMPTY EDITOR
3229:         MOVE AC1,PPHPOS(DAT)
3230:         EXCH AC1,LSTHP(DAT)
3231:         CAMN AC1,LSTHP(DAT)     ;SEE IF LE HAS MOVED HORIZONTALLY
3232:         JRST DPTL1A             ;NO
3233:         PUSHJ P,LEFIX           ;YES - RECALCULATE TABS & LONG-LINE CRLFS
3234:         SETOM LETXC(DAT)        ;TEXT NOW NEEDS WRITING
3235: DPTL1A: MOVE AC1,NCRS(DAT)      ; WE GET HERE IF THE VERTICAL POSITION IS THE SAME
3236:         CAMGE AC1,LENCRS(DAT)   ; NOW HAS THE LINE SHRUNK ANY?
3237:         PUSHJ P,DPEOSL          ; YES, ERASE LINES PAST FIRST ONE.
3238:         MOVE AC1,CVP(DAT)       ; PICK UP CURSOR VERTICAL POSITION
3239:         CAME AC1,LECVP(DAT)     ; HAS THE CURSOR VERTICAL POSITION CHANGED?
3240:         JRST DPTLE2             ; YES, SEE HOW MUCH AND WHERE IT IS NOW.
3241:         MOVE AC1,CHP(DAT)       ; IF THE VERTICAL POSITION IS THE SAME,
3242:         CAME AC1,LECHP(DAT)     ; THEN HOW ABOUT THE HORIZONTAL POSITION?
3243:         JRST DPTLE3             ; DIFFERENT, GO SEND OUT A NEW ONE.
3244:         MOVE AC1,PPHPOS(DAT)    ;SEE IF PP CURSOR MOVED
3245:         CAME AC1,LEHP(DAT)
3246:         JRST DPTLE6             ; YES, GO SEND IT OUT AGAIN
3247:         SKIPN LETXC(DAT)        ; HAS THE TEXT CHANGED?
3248:         SKIPE LEMISS(DAT)       ; OR DID THE LINE EDITOR MISS A BEAT DUE TO AN INVALID BUFFER?
3249:         JRST DPTL12             ; YES, SEND OUT THE TEXT AGAIN
3250:         SETZM LECLK(DAT)        ; NO, NOTHING AT ALL TO DO!
3251:         CONO PI,SCNON
3252:         POPJ P,
    DPYSER page# 0080 next  prev
3254: ; LINE EDITOR DECISION TREE. WE GET HERE IF THE LINE EDITOR CURSOR HAS NOT
3255: ; MOVED, BUT THE PAGE PRINTER CURSOR HAS(???)
3256: 
3257: DPTLE6: MOVE AC1,CVP(DAT)       ; ARE THE TWO CURSORS ON THE SAME LINE?
3258:         CAME AC1,VPOS(UUO)
3259:         JRST DPTLE7             ; NO, THEY CAN BE SENT OUT SEPARATELY.
3260: DPTLE9: PUSHJ P,DPWB            ; YES, SEND OUT BOTH
3261:         JRST DPTLE4
3262: 
3263: DPTLE7: PUSHJ P,DPWPC           ; WRITE OUT THE PAGE PRINTER CURSOR ALONE
3264:         JRST DPTLE4             ; DO TEXT CHECK AND LEAVE
3265: 
3266: DPTLE2: MOVE AC1,LELINE(DAT)    ; WE COME HERE IF THE CURSOR VERTICAL POSITION HAS CHANGED
3267:         CAME AC1,LECVP(DAT)     ; IS THE OLD VERTICAL POSITION THE SAME AS THE PAGE PRINTER?
3268:         PUSHJ P,DPEC            ; NO, ERASE THE OLD CURSOR
3269:         MOVE AC1,LELINE(DAT)    ; PICK UP VERTICAL POSITION AGAIN
3270:         CAMN AC1,CVP(DAT)       ; IS IT THE SAME AS THE CURSOR POSITION?
3271:         JRST DPTLE9             ; YES, SEND OUT BOTH CURSORS
3272: DPTLE8: PUSHJ P,DPWPC           ; NO, SEND OUT THE PAGE PRINTER'S
3273: DPTL11: PUSHJ P,DPWC            ; SEND OUT THE LINE EDITOR CURSOR TOO
3274:         JRST DPTLE4
3275: 
3276: DPTLE3: PUSHJ P,DPEC            ; ERASE THE CURSOR
3277:         MOVE AC1,LELINE(DAT)    ; PICK UP THE VERTICAL POSITION
3278:         CAMN AC1,CVP(DAT)       ; IS IT THE SAME AS THE CURSOR POSITION
3279:         JRST DPTLE9             ; YES, SEND THEM BOTH OUT
3280:         PUSHJ P,DPWC            ; WRITE OUT OUR CURSOR
3281:         MOVE AC1,PPHPOS(DAT)    ;GET PP CURSOR POS
3282:         CAME AC1,LEHP(DAT)      ; IS IT THE SAME AS THE CURRENT POSITION?
3283:         PUSHJ P,DPWPC           ; NO, WRITE OUT ANOTHER PAGE PRINTER CURSOR
3284:         JRST DPTLE4             ; YES, NO NEED TO WRITE A NEW ONE
    DPYSER page# 0081 next  prev
3286: ; EVERYBODY COMES HERE TO EXIT
3287: 
3288: DPTLE4: SKIPN LETXC(DAT)        ; HAS THE TEXT CHANGED?
3289:         SKIPE LEMISS(DAT)       ; OR DID I-LEVEL MISS DUE TO BUFFER INVALID?
3290: DPTL12: PUSHJ P,DPWT            ; YES, QUEUE UP A TEXT REQUEST
3291: DPTLE5: MOVE AC1,LELINE(DAT)    ; SAVE NEW STATE OF LINE EDITOR AND CURSORS
3292:         MOVEM AC1,LEVP(DAT)
3293:         MOVE AC1,PPHPOS(DAT)
3294:         MOVEM AC1,LEHP(DAT)
3295:         MOVE AC1,NCRS(DAT)      ; NUMBER OF CRLFS IN LINE TOO
3296:         MOVEM AC1,LENCRS(DAT)
3297:         MOVE AC1,CVP(DAT)       ; CURSOR VERTICAL POSITION
3298:         MOVEM AC1,LECVP(DAT)
3299:         SETZM LETXC(DAT)        ; CLEAR THE FLAGS
3300:         SETZM LEMISS(DAT)
3301:         MOVE AC1,CHP(DAT)       ; CURSOR HORIZONTAL POSITION
3302:         MOVEM AC1,LECHP(DAT)
3303:         CONO PI,SCNON
3304:         POPJ P,                 ; BYE NOW. Y'ALL HAVE A GOOD TIME!
    DPYSER page# 0082 next  prev
3306: ; THIS ROUTINE QUEUES UP A LINE EDITOR TEXT REQUEST
3307: 
3308: DPWT:   PUSHJ P,GETQ            ; GET A TASK BLOCK
3309:         PUSH P,AC1              ; SAVE ITS ADDRESS
3310:         PUSHJ P,GETQ            ; GET ANOTHER ONE
3311:         MOVE AC2,(P)            ; PICK UP ADDRESS OF FIRST ONE AGAIN
3312:         MOVEI AC3,LEXFR         ; CALL THE LINE EDITOR I-LEVEL ROUTINE
3313:         HRRM AC3,(AC1)          ; PUT IT IN THE DISPATCH ADDRESS OF EACH TASK BLOCK
3314:         HRRM AC3,(AC2)
3315:         MOVE AC3,LELINE(DAT)    ; PICK UP VERTICAL POSITION OF LINE EDITOR BUFFER
3316:         HRLM AC3,QLINE(AC1)     ; START THE TRANSFER HERE
3317:         HRLM AC3,QLINE(AC2)
3318:         HRLM DAT,(AC1)          ; PUT IN ADDRESS OF DPY PROGRAM HEADER
3319:         HRLM DAT,(AC2)
3320:         ADD AC3,NCRS(DAT)       ; GET NUMBER OF LAST LINE OF TRANSFER
3321: DPWT1:  HRRM AC3,QLINE(AC1)     ; SET THAT AS LAST LINE
3322:         HRRM AC3,QLINE(AC2)
3323:         SETZM QFIELD(AC1)       ; SEND OUT TASKS OUT ON OPPOSITE FIELDS
3324:         SETOM QFIELD(AC2)
3325:         HRLI DAT,DPLED          ; MAKE UP A CLOCK REQUEST WORD
3326:         MOVEM DAT,QWAKE(AC1)
3327:         MOVEM DAT,QWAKE(AC2)
3328:         SKIPN AC3,SC(UUO)       ; IS THERE A COUNT WORD?
3329:         JRST DPWT2              ; NO, DON'T BOTHER
3330:         AOS @SC(UUO)            ; YES, BUMP IT TWICE
3331:         AOS @SC(UUO)
3332: DPWT2:  MOVEM AC3,QCOUNT(AC1)
3333:         MOVEM AC3,QCOUNT(AC2)
3334:         PUSHJ P,QBLOCK          ; QUEUE UP THE FIRST ONE
3335:         POP P,AC1               ; GET THE ADDRESS OF THE SECOND ONE
3336:         JRST QBLOCK             ; QUEUE IT UP TOO.
    DPYSER page# 0083 next  prev
3338: ; THIS ROUTINE ERASES THE OLD SECOND LINE OF THE LINE EDITOR
3339: 
3340: DPEOSL: PUSHJ P,GETQ            ; GET A TASK BLOCK
3341:         PUSH P,AC1
3342:         PUSHJ P,GETQ
3343:         MOVE AC2,(P)
3344:         MOVEI AC3,ERASE
3345:         HRRM AC3,(AC1)
3346:         HRRM AC3,(AC2)
3347:         MOVE AC3,LELINE(DAT)    ; PICK UP VERTICAL POSITION
3348:         ADD AC3,NCRS(DAT)       ; ADD IN LENGTH OF TRANSFER
3349:         ADDI AC3,1              ; BUMP LINE NUMBER TO ONE PAST THE CURRENT LAST LINE
3350:         HRLM AC3,QLINE(AC1)     ; PUT THAT IN AS STARTING AND ENDING LINE
3351:         HRLM AC3,QLINE(AC2)
3352:         MOVE AC3,LEVP(DAT)      ; PICK UP LAST VERTICAL POSITION
3353:         ADD AC3,LENCRS(DAT)     ; ADD IN LENGTH OF LAST TRANSFER
3354: DPEOS1: HRLM UUO,(AC1)          ; PUT IN ADDRESS OF PAGE PRINTER CONTROL BLOCK
3355:         HRLM UUO,(AC2)
3356:         JRST DPWT1
    DPYSER page# 0084 next  prev
3358: ; THIS ROUTINE ERASES THE OLD CURSOR
3359: 
3360: DPEC:   SKIPA AC2,LECVP(DAT)    ;OLD POSITION
3361: DPEOPC: MOVE AC2,LEVP(DAT)      ;SAME THING FOR PP CURSOR
3362:         JUMPL AC2,CPOPJ         ;WARN'T NONE
3363:         PUSHJ P,GETQ
3364: DPEC1:  HRLM AC2,QLINE(AC1)     ; PUT THAT IN AS STARTING LINE
3365: ;       ADDI AC2,1              ; BUMP IT BY ONE
3366:         HRRM AC2,QLINE(AC1)     ; FOR PESSIMISM
3367:         SETOM QHPOS(AC1)        ; CLEAR THE HORIZONTAL POSITION, INDICATING CURSOR ERASURE
3368: DPEC2:  SETZM QFIELD(AC1)       ; GOING OUT ON FIELD 1
3369:         HRLI DAT,DPLED
3370:         MOVEM DAT,QWAKE(AC1)    ; WAKE UP THE LINE EDITOR DECISION TREE WHEN DONE
3371:         MOVE AC3,SC(UUO)        ; COUNT THROUGH OUR COUNTER TOO
3372:         MOVEM AC3,QCOUNT(AC1)
3373:         SKIPE SC(UUO)           ; IS THERE A COUNT WORD?
3374:         AOS @SC(UUO)            ; YES, BUMP IT BY ONE
3375:         HRLM UUO,(AC1)          ; SAVE THE PAGE PRINTER CONTROL BLOCK ADDRESS
3376:         MOVEI AC3,CURSOR        ; USE THE CURSOR SUBROUTINE
3377:         HRRM AC3,(AC1)
3378:         JRST QBLOCK             ; QUEUE UP THE REQUEST
    DPYSER page# 0085 next  prev
3380: ; THESE ROUTINES QUEUE UP THE VARIOUS COMBINATIONS OF CURSORS THAT MAY ARISE.
3381: 
3382: DPWPC:  PUSHJ P,GETQ            ; GET A TASK BLOCK FOR THE PAGE PRINTER'S CURSOR
3383:         MOVE AC2,LELINE(DAT)    ; GET IT'S VERTICAL POSITION
3384:         MOVE AC3,PPHPOS(DAT)
3385: DPWPC1: SETOM QHPOS(AC1)        ; CLEAR OUT ONE OF THE HORIZONTAL POSITION WORDS
3386: DPWPC2: HRLM AC2,QLINE(AC1)     ; STORE THE STARTING LINE NUMBER OF THE TRANSFER
3387: ;       ADDI AC2,1              ; FOR SAFETY, MAKE IT LOOK LIKE IT IS TWO LINES LONG
3388:         HRRM AC2,QLINE(AC1)     ; AND STORE THAT AS THE DESTINATION LINE NUMBER
3389:         HRLM AC3,QHPOS(AC1)     ; STORE THE HORIZONTAL POSITION
3390:         JRST DPEC2              ; FINISH QUEUEING UP THE BLOCK
3391: 
3392: ; THIS ROUTINE QUEUES UP A LINE EDITOR CURSOR ONLY.
3393: 
3394: DPWC:   PUSHJ P,GETQ            ; GET A TASK BLOCK
3395:         MOVE AC2,CVP(DAT)       ; PICK UP THE CURSOR VERTICAL POSITION
3396:         MOVE AC3,CHP(DAT)       ; GET THE HORIZONTAL POSITION
3397:         JRST DPWPC1             ; LET THE ABOVE ROUTINE DO ALL THE WORK
3398: 
3399: ; THIS ROUTINE QUEUES UP A TRANSFER WITH TWO CURSORS ON THE SAME LINE
3400: 
3401: DPWB:   PUSHJ P,GETQ
3402:         MOVE AC2,LELINE(DAT)
3403:         MOVE AC3,CHP(DAT)       ; PICK UP THE LINE EDITOR CURSOR'S HORIZONTAL POSITION
3404:         HRRM AC3,QHPOS(AC1)     ; PUT IT IN AS ONE OF THE HORIZONTAL POSITIONS INVOLVED
3405:         MOVE AC3,PPHPOS(DAT)    ;GET PP CURSOR POS
3406:         JRST DPWPC2             ; USE IT TOO.
    DPYSER page# 0086 next  prev
3408: ;QBLOCK   HERE IS THE MAGIC SCHEDULING QUEUE ROUTINE
3409: ; IT IS CALLED WITH THE ADDRESS OF A TASK BLOCK IN AC1. SAID BLOCK
3410: ; MUST HAVE QLINE AND QFIELD SET, BECAUSE THE BLOCK IS MERGED INTO
3411: ; THE QUEUE STRUCTURE IN THE RIGHT PLACE ON THE BASIS OF THOSE DATA.
3412: 
3413: ;   ∃ BLOCKS CALLED "FRAMES".  EACH FRAME HAS A POINTER TO A LIST OF ONE OR
3414: ; MORE TASK BLOCKS, ALL OF WHICH HAVE THE SAME FIELD (EITHER EVEN OR ODD).
3415: ; THE TASK BLOCKS ARE LISTED IN ASCENDING ORDER OF LINE NUMBER. IN GENERAL,
3416: ; THE LIST OF FRAMES ALTERNATES BY FIELD PARITY, THE EXCEPTION BEING 
3417: ; "MISSING" FRAMES.  FRAME BLOCK FORMAT IS:
3418: ;
3419: ;               XWD 0,<POINTER TO NEXT FRAME, OR 0>
3420: ;       QLINE:  BITS 0-19 INDICATE WHICH LINES ARE USED BY TASK BLOCKS
3421: ;                 IN THIS FRAME.  BITS 0,1,2 FOR LINES 1&2,3&4,5&6, ETC.
3422: ;       QFIELD: SAME AS IN A TASK BLOCK, 0 OR -1 FOR EVEN OR ODD FIELD.
3423: ;       QHPOS:  NOT USED
3424: ;       QLINK:  XWD 0,<ADDRESS OF 1ST TASK BLOCK>
3425: 
3426: QBLOCK: HGMAC(32)
3427:         MOVEI AC2,10            ; SET FOR 8 TIMES THROUGH
3428:         MOVEM AC2,QTIME(AC1)    ; BEFORE WE DECLARE IT A LOSING TRANSFER
3429: REQBLK: HRRZ AC2,(AC1)
3430:         CAIL AC2,PPXFR
3431:         CAILE AC2,PPSTAR
3432:         JRST QBLERR
3433:         HLRZ AC2,(AC1)
3434:         CAML AC2,MEMSIZ
3435:         CAMLE AC2,RMEMSIZ
3436:         JUMPN AC2,QBLERR        ; IF THERE IS SOMETHING THERE NOT IN FREE STORAGE, ERROR!
3437:         SKIPN INTACT(PID)       ; IS SOME WISEASS CALLING US AT USER INTERRUPT LEVEL?
3438:         JRST QBLCLC             ; NO, ALL IS WELL.
3439:         HRLI AC1,QBLCLK         ; YES, PUT IN A CLOCK REQUEST TO DO THIS TASK AT REAL CLOCK LEVEL
3440:         CONO PI,PIOFF
3441:         IDPB AC1,CLKQ
3442:         CONO PI,PION
3443:         POPJ P,                 ; PRETEND WE DID IT.
    DPYSER page# 0087 next  prev
3445: ; HERE WE SEE IF THE TASK IS AN EASY OUTSIDER.
3446: ; IF IT IS NOT, WE MAKE UP A MASK FOR THE NUMBER OF
3447: ; LINES IT COVERS.
3448: 
3449: QBLCLK: HRRZ AC1,DAT            ; PICK UP THE TASK BLOCK ADDRESS
3450: QBLCLC: PUSH P,TAC              ; SAVE THE WORLD
3451:         PUSH P,TAC1
3452:         PUSH P,DAT
3453:         PUSH P,UCHN
3454:         PUSH P,CHR
3455:         HLRE DAT,QLINE(AC1)     ; PICK UP STARTING POSITION
3456:         HRRE UCHN,QLINE(AC1)    ; AND THE ENDING LINE NUMBER
3457:         JUMPLE UCHN,QOOB        ; IF ENDING LINE IS OUT OF BOUNDS, THIS IS AN EASY OUTSIDER
3458:         SKIPN DDOFF             ; IF DD IS BEING MAINTAINED, PRETEND THE TRANSFER IS OUT OF BOUNDS
3459:         CAILE DAT,=40           ; OR IF STARTING LINE IS BELOW SCREEN . . .
3460:         JRST QOOB               ; IS AN EASY OUTSIDER
3461:         CAIG DAT,(UCHN)         ; IS THE STARTING LESS THAN THE FINISHING?
3462:         AOJA UCHN,QBLGO         ;CAN'T MAKE NEXT LINE
3463:         PUSHACS
3464:         PUSHJ P,DISERR
3465:         [ASCIZ /STARTING LINE LESS THAN FINISHING LINE AT QBLOCK
3466: /]
3467:         -1
3468:         POPACS
3469: QBLGO:  SETZ TAC,               ; HERE WE MAKE A 20-BIT MASK, IN BITS
3470:         SETO TAC1,              ;       0-19 OF TAC, WHERE EACH BIT
3471:         ADDI DAT,1              ;       REPRESENTS 2 LINES, AND IS ON
3472:         ADDI UCHN,1             ;       IF EITHER LINE IS TO BE WRITTEN
3473:         LSH DAT,-1
3474:         LSH UCHN,-1
3475:         SUBM DAT,UCHN
3476: IFN FTDDSTAT,<                  ;ONLY IF COUNTING STATISTICS
3477:         ADDM    UCHN,NDDLCT     ;COUNT  -(TOTAL NUMBER OF LINES QUEUED)
3478:         AOS     NDDXCT          ;COUNT TOTAL NUMBER OF TRANSFERS QUEUED.
3479:         CAML    UCHN,[-2]
3480:         AOS     NDDL1C          ;COUNT 1 AND 2 LINE TRANSFERS.
3481: >
3482:         ROTC TAC,-1(UCHN)
3483:         MOVN UCHN,DAT
3484:         ROT TAC,1(UCHN)         ; C(TAC) IS THE PROPER 20-BIT MASK
    DPYSER page# 0088 next  prev
3486: ; HERE WE SCAN THE QUEUE SYSTEM LOOKING FOR A FRAME WITH SOME FREE LINES
3487: 
3488: QBL1:   MOVE DAT,QFIELD(AC1)    ; WE WILL ENTER THE TASK ON ITS FIELD
3489:         MOVE AC3,QLINE(AC1)     ; MERGE BY LINE NUMBER
3490:         MOVE AC2,1              ; SET THE FIELD SAVED WORD TO DIFFERENT FROM ANY LEGAL FIELD
3491:         MOVEM AC2,DDLFD
3492:         SETZB AC2,DDLST         ; NOTE THAT THERE IS NO LAST FRAME
3493:         EXCH AC2,DDQUE          ; PICK UP (SHUDDER!) THE ENTIRE QUEUE STRUCTURE
3494:         JUMPE AC2,QBL3          ; IF THERE ISN'T ANY, MAKE UP ONE FROM SCRATCH.
3495:         MOVEM AC2,DDSQ          ; IF THERE IS ONE, SAVE IT FIRST.
3496: CNXTFR: CAME DAT,QFIELD(AC2)    ; IS THIS FRAME ON THE RIGHT FIELD?
3497:         JRST QBL4               ; NO, MOVE ON TO NEXT FRAME
3498:         TDNE TAC,QLINE(AC2)     ; YES, IS THERE ROOM ON THIS FRAME?
3499:         JRST QBL8               ; NO, GO ON TO NEXT FRAME
3500:         ORM TAC,QLINE(AC2)      ; YES, MARK OUR LINES AS CLAIMED
3501: QBL6:   HRRZ CHR,QLINK(AC2)     ; PICK UP ADDRESS OF TASK LIST FOR THIS FRAME
3502:         JUMPE CHR,QBL7          ; NONE THERE, ANNEX OUR TASK
3503:         MOVE AC2,CHR            ; SAVE THIS TASK BLOCK ADDRESS FOR ANNEXATION PURPOSES
3504:         CAMLE AC3,QLINE(AC2)    ; NOW, DO WE GO ABOVE THIS BLOCK?
3505:         JRST QBL6               ; NO, TRY NEXT BLOCK
3506:         HRRM AC2,QLINK(AC1)     ; YES, LINK US IN BETWEEN THESE TWO BLOCKS
3507:         HLRZ AC3,QLINK(AC2)     ; PICK UP POINTER TO PREVIOUS TASK
3508:         HRLM AC3,QLINK(AC1)     ; MAKE OUR BACKWARD LINK POINT TO THE LAST BLOCK
3509:         HRRM AC1,QLINK(AC3)     ; MAKE THE LAST BLOCK POINT TO US
3510:         HRLM AC1,QLINK(AC2)     ; MAKE THE NEXT BLOCK'S REVERSE POINTER POINT TO US
3511:         JRST QBLXIT             ; PUT THE QUEUE STRUCTURE BACK AND LEAVE
3512: 
3513: QBL7:   HRRM AC1,QLINK(AC2)     ; ANNEX US BY PUTTING OUR ADDRESS IN THE LAST BLOCK'S FORWARD POINTER
3514:         HRLZM AC2,QLINK(AC1)    ; AND POINT OUR REVERSE POINTER TO HIM
3515:         JRST QBLXIT
    DPYSER page# 0089 next  prev
3517: ; WE GET HERE IF THE TASK IS ENTIRELY OUT OF BOUNDS
3518: 
3519: QOOB:   PUSHJ P,WAKEQ           ; WAKE UP ANYONE WAITING.
3520:         POP P,CHR               ; RESTORE THE WORLD.
3521:         POP P,UCHN
3522:         POP P,DAT
3523:         POP P,TAC1
3524:         POP P,TAC
3525: GIVQB:  JRST GIVQ
3526: 
3527: ; WE GET HERE IF EITHER THE DISPATCH ADDRESS OR THE DATA BLOCK ADDRESS
3528: ; IS ILLEGAL.
3529: 
3530: QBLERR: PUSH P,(AC1)
3531:         PUSHJ P,DISERR
3532:         [ASCIZ /ILLEGAL TASK AT QBLOCK - /]
3533:         DISARG OCT,<-1(P)>
3534:         [ASCIZ /
3535: /]
3536:         -1
3537:         SUB P,[XWD 1,1]
3538:         JRST GIVQ
3539: 
3540: WAKEQ:  SKIPE QCOUNT(AC1)       ; IS THERE A COUNT HERE?
3541:         SOSLE @QCOUNT(AC1)      ; PERHAPS WE HAVE TO GO THROUGH THE WAKEUP RITUAL?
3542:         POPJ P,                 ; NOT YET.
3543:         SKIPN AC2,QWAKE(AC1)    ; YES WE DO. PICK UP WAKEUP WORD
3544:         POPJ P,
3545:         TDNE AC2,[-100]         ; IS IT A JOB NUMBER?
3546:         JRST WAKEQ1             ; NO, MUST BE A CLOCK REQUEST
3547:         SKIPL JBTSTS(AC2)       ; MAKE SURE HE IS STILL RUNABLE
3548:         POPJ P,                 ; NO, LEAVE NOW
3549:         MOVNI AC3,RUNQ          ; PUT THAT JOB IN THE RUN QUEUE
3550:         MOVEM AC3,JOBQUE(AC2)
3551:         MOVEI AC3,QJOB(AC2)
3552:         CONO PI,PIOFF
3553:         SKIPE (AC3)
3554:         JRST .+3
3555:         EXCH AC3,QJOB
3556:         HRROM AC3,@QJOB
3557:         CONO PI,PION
3558:         POPJ P,
3559: 
3560: WAKEQ1: CONO PI,PIOFF           ; STOP THE WORLD!
3561:         IDPB AC2,CLKQ           ; PUT IN THE CLOCK REQUEST
3562:         CONO PI,PION
3563:         POPJ P,
    DPYSER page# 0090 next  prev
3565: ; WE GET HERE WHEN THERE IS NO QUEUE AT ALL.
3566: 
3567: QBL3:   PUSHJ P,MAKFRM          ; MAKE UP A NEW FRAME HEADER
3568:         MOVEM AC1,DDSQ          ; MAKE THIS THE NEW QUEUE
3569:         JRST QBLXIT             ; RESTORE ACCUMULATORS AND LEAVE.
3570: 
3571: ; HERE IS A ROUTINE TO MAKE UP A NEW FRAME HEADER AND PUT THE CURRENT
3572: ; BLOCK IN IT AS ITS ONLY TASK.
3573: 
3574: MAKFRM: PUSH P,AC1              ; SAVE THE TASK BLOCK ADDRESS
3575:         AOS NDDFRM              ; COUNT ONE MORE FRAME CREATION
3576:         PUSHJ P,GETQ            ; GET A BLOCK FOR THE FRAME HEADER
3577:         SETZM (AC1)             ; LINK IT TO NOWHERE FOR NOW.
3578:         MOVEM TAC,QLINE(AC1)    ; PUT IN OUR MASK AS THE INITIAL MASK FOR THE FRAME
3579:         MOVEM DAT,QFIELD(AC1)   ; STORE THE FIELD WORD AS THIS FRAME'S FIELD
3580:         POP P,AC2               ; GET BACK THE TASK BLOCK ADDRESS
3581:         HRRZM AC2,QLINK(AC1)    ; POINT THE FRAME HEADER TO US
3582:         HRLZM AC1,QLINK(AC2)    ; AND OUR BACKWARD POINTER TO THE FRAME HEADER
3583:         POPJ P,
3584: 
3585: ; WE GET HERE IF THIS FRAME HAS THE WRONG FIELD
3586: 
3587: QBL4:   CAME DAT,DDLFD          ; DOES THE LAST FRAME ALSO HAVE THE WRONG FIELD?
3588:         SKIPN DDLST             ; YES, DO WE EVEN HAVE A LAST FRAME?
3589:         JRST QBL5               ; NO TO EITHER, MOVE ON TO NEXT FRAME
3590:         PUSH P,AC2              ; SAVE POINTER TO CURRENT FRAME
3591:         PUSHJ P,MAKFRM          ; MAKE UP A BRAND NEW AND DIFFERENT FRAME
3592:         MOVEM AC1,@DDLST        ; INSERT IT BETWEEN THESE TWO
3593:         POP P,(AC1)             ; POINT IT TO THE SUCCESSOR
3594:         JRST QBLXIT
    DPYSER page# 0091 next  prev
3596: ; HERE IS A ROUTINE THAT MOVES ON TO THE NEXT FRAME, IF THERE IS NO NEXT
3597: ; FRAME, IT MAKES UP A FRAME AND ANNEXES IT ONTO THE FRAME LIST.
3598: 
3599: QBL8:   MOVEM DAT,DDLFD         ; SAVE THE FIELD OF THE FRAME
3600:         JRST QBL9
3601: 
3602: QBL5:   SETCAM DAT,DDLFD        ; SAVE THE FIELD OF THE FRAME (OPPOSITE FROM US)
3603: QBL9:   HRRZM AC2,DDLST         ; SAVE THE ADDRESS OF THE LAST FRAME
3604:         HRRZ AC2,(AC2)          ; PICK UP ADDRESS OF NEXT FRAME
3605:         JUMPN AC2,CNXTFR        ; IF THERE IS ONE, GO CHECK IT OUT.
3606:         PUSHJ P,MAKFRM          ; OTHERWISE, MAKE UP A NEW FRAME HEADER
3607:         HRRZM AC1,@DDLST                ; LINK US ON TO THE FRAME LIST
3608: QBLXIT: PUSHJ P,DDQCHK
3609:         MOVE AC2,DDSQ           ; ALL DONE, PUT THE TASK QUEUE BACK
3610:         MOVEM AC2,DDQUE
3611:         AOS NDDQUE              ; MARK ONE MORE IN THE QUEUE
3612:         POP P,CHR               ; RESTORE THE ACCUMULATORS
3613:         POP P,UCHN
3614:         POP P,DAT
3615:         POP P,TAC1
3616:         POP P,TAC
3617:         CONO PI,PIOFF           ; STOP THE WORLD WHILE WE START UP THE DATA DISC
3618:         SKIPN DDRUN             ; IS THE DISK RUNNING?
3619:         SETOM DDSTART           ; NO, START IT UP NEXT TICK
3620:         CONO PI,PION
3621:         POPJ P,
3622: 
3623: ;CHECK STATE OF DD QUEUE.  CALL BEFORE SETTING UP DDQUE FROM DDSQ
3624: DDQCHK: MOVEI DAT,DDSQ
3625: DDQCH1: SKIPN AC1,(DAT)
3626:         POPJ P,
3627:         CAMGE AC1,MEMSIZ
3628:         JRST DDQCE3             ;ADDRESS OUT OF BOUNDS
3629:         MOVSI CHR,-1
3630:         TDNN CHR,(AC1)
3631:         TDNE CHR,QLINK(AC1)
3632:         JRST DDQCE1             ;EXTRANEOUS BITS ON IN FRAME
3633: ;reg    MOVEI CHR,77777
3634: ;       TDNE CHR,QLINE(AC1)
3635: ;       JRST DDQCE1             ;EXTRANEOUS BITS IN QLINE
3636:         SKIPE CHR,QFIELD(AC1)
3637:         AOJN CHR,DDQCE2         ;QFIELD NOT 0 OR -1
3638:         HRRZ AC2,QLINK(AC1)     ;POINTER TO TASK BLOCK
3639:         JUMPE AC2,DDQCH4
3640:         CAMGE AC2,MEMSIZ
3641:         JRST DDQCE3
3642:         PUSHJ P,DDTSCH          ;CHECK LIST OF TASK BLOCKS
3643: DDQCH4: MOVE DAT,AC1
3644:         JRST DDQCH1
3645: 
3646: DDQCE3: JSP CHR,DDCHER
3647:         PUSHJ P,DISMES
3648:         ASCIZ /FRAME BLOCK OR TASK BLOCK ADDRESS OUT OF BOUNDS /
3649:         JRST DDCKR1
3650: 
3651: DDQCE2: JSP CHR,DDCHER
3652:         PUSHJ P,DISMES
3653:         ASCIZ /QFIELD NOT ZERO OR ONE /
3654:         JRST DDCKR1
3655: 
3656: DDQCE1: JSP CHR,DDCHER
3657:         PUSHJ P,DISMES
3658:         ASCIZ /EXTRANEOUS BITS ON /
3659: DDCKR1: PUSHJ P,DISMES
3660:         ASCIZ /IN FRAME BLOCK AT /
3661:         MOVE TAC,-17+AC1(P)
3662:         PUSHJ P,DISLOC
3663:         PUSHJ P,DISMES
3664:         ASCIZ /
3665: PREVIOUS FRAME BLOCK AT /
3666:         MOVE TAC,-17+DAT(P)
3667:         PUSHJ P,DISLOC
3668: DDCKR3: PUSHJ P,DISMES
3669:         ASCIZ /
3670: FIND A WIZARD OR TYPE POPJ 3,$X
3671: /
3672:         PUSHJ P,DISFLUSH
3673:         POPACS                  ;SO WE DON'T HAVE TO LOOK HARD TO FIND THE AC'S
3674:         PUSHJ P,DDTCALL 
3675:         JRST DDQCH4             ;MAYBE IT'S POSSIBLE TO CONTINUE
3676: 
3677: DDCHER: PUSHACS
3678:         PUSHJ P,DISMES
3679:         ASCIZ /DATA DISK QUEUE INCONSISTENT
3680: /
3681:         JRST @-17+CHR(P)
3682: 
3683: ;CHECK TASK LIST POINTED TO BY AC2 , AC1 POINTS TO FRAME IT COMES FROM
3684: DDTSCH: PUSH P,AC1
3685: DDTSC2: HRRZ CHR,(AC2)          ;ADDRESS OF TASK ROUTINE
3686:         CAIL CHR,DWPINI
3687:         CAIL CHR,WHOINI
3688:         JRST DDTSE4
3689:         SKIPE CHR,QFIELD(AC2)
3690:         AOJN CHR,DDTSE1         ;QFIELD NOT 0 OR -1
3691:         HLRZ CHR,QLINK(AC2)     ;BACKWARDS LINK
3692:         CAIE CHR,(AC1)
3693:         JRST DDTSE2             ;BACKWARDS LINK IS WRONG
3694:         HRRZ AC1,AC2
3695:         HRRZ AC2,QLINK(AC2)     ;GET FORWARD LINK
3696:         JUMPE AC2,DDTSC1        ;END OF LIST
3697:         CAMGE AC2,MEMSIZ
3698:         JRST DDTSE3             ;TASK LINK OUT OF BOUNDS
3699:         JRST DDTSC2
3700: 
3701: DDTSC1: POP P,AC1
3702:         POPJ P,
3703: 
3704: DDTSE4: JSP CHR,DDCHER
3705:         PUSHJ P,DISMES
3706:         ASCIZ /TASK ROUTINE ADDRESS OUT OF RANGE /
3707:         JRST DDCKR2
3708: 
3709: DDTSE3: JSP CHR,DDCHER
3710:         PUSHJ P,DISMES
3711:         ASCIZ /FORWARD LINK OUT OF BOUNDS /
3712:         JRST DDCKR2
3713: 
3714: DDTSE2: JSP CHR,DDCHER
3715:         PUSHJ P,DISMES
3716:         ASCIZ /BACKWARS LINK WRONG /
3717:         JRST DDCKR2
3718: 
3719: DDTSE1: JSP CHR,DDCHER
3720:         PUSHJ P,DISMES
3721:         ASCIZ /QFIELD NOT ZERO OR ONE /
3722: DDCKR2: PUSHJ P,DISMES
3723:         ASCIZ /IN TASK BLOCK AT /
3724:         MOVE TAC,-17+AC2(P)
3725:         PUSHJ P,DISLOC
3726:         PUSHJ P,DISMES
3727:         ASCIZ /
3728: PREVIOUS TASK BLOCK (MAYBE FRAME BLOCK) AT /
3729:         MOVE TAC,-17+AC1(P)
3730:         PUSHJ P,DISLOC
3731:         JRST DDCKR3
    DPYSER page# 0092 next  prev
3733: ; HERE LIES THE INCREDIBLE INTERRUPT-LEVEL ROUTINES!
3734: ; LET THE READER BEWARE.
3735: 
3736: ↑DDSTRT:
3737:         SETZM DDSTART
3738:         SKIPN DDQUE             ; IS THERE ANYTHING FOR US?
3739:         JRST APRADD             ; NO, LEAVE NOW
3740:         SETOM DDRUN             ; WE ARE NOW OFFICIALLY RUNNING.
3741:         MOVEM TAC,DDSTAC        ; SAVE THE ACCUMULATORS
3742:         MOVEM AC1,DDSAC1
3743:         MOVEM AC2,DDSAC2
3744:         MOVEM AC3,DDSAC3
3745:         MOVEM DAT,DDSDAT
3746:         EXCH P,APRPDL(PID)      ; GET US A PDL TOO
3747:         MOVEI AC3,APRADD        ; WE WILL RETURN TO APRINT WHEN WE ARE DONE
3748:         MOVEM AC3,DDRET
3749:         MOVE AC1,DDQUE          ; REMOVE THE FIRST FRAME FROM THE QUEUE ENTIRELY
3750: NEWFRM: MOVE AC2,(AC1)          ; PICK UP THE ADDRESS OF THE NEXT FRAME
3751:         MOVEM AC2,DDQUE         ; MAKE IT THE NEW QUEUE
3752:         MOVEM AC1,DDCURQ        ; SAVE THIS ADDRESS AS OUR CURRENT FRAME
3753:         HRRZ TAC,QLINK(AC1)     ; PICK UP THE ADDRESS OF THE FIRST TASK IN THE FRAME
3754: SCNLOP: HRRZ AC2,QLINK(TAC)     ; PICK UP THE ADDRESS OF THE NEXT TASK
3755:         MOVEM AC2,DDNXT         ; SAVE IT FOR FUTURE REFERENCE
3756:         HLRZ DAT,(TAC)          ; PICK UP THE DATA BLOCK ADDRESS
3757:         HRRZ AC3,(TAC)          ; AND THE ROUTINE ADDRESS
3758:         CAIL AC3,DWPINI
3759:         CAIL AC3,WHOINI
3760:         CAIA                    ;LET'S NOT JUMP TO CONTUSIONS
3761:         JRST (AC3)              ; JUMP OFF TO THE ROUTINE
3762:         PUSH P,CHR              ;IN CASE WE WANT TO LOOK AT CHR
3763:         MOVEI DAT,DDCURQ
3764:         PUSHJ P,DDQCH1          ;SHOULDN'T EVER RETURN
3765:         PUSHJ P,DDTCALL
3766:         JRST AUTOLOAD
    DPYSER page# 0093 next  prev
3768: ; ALL THE I-LEVEL ROUTINES RETURN TO HERE WHEN THEY ARE DONE
3769: 
3770: RESCAN: SKIPE TAC,DDNXT         ; IS THERE ANOTHER TASK IN THIS FRAME?
3771:         JRST SCNLOP             ; YES, SERVE IT NOW.
3772:         HRRZ AC1,DDCURQ         ; PICK UP THE FRAME HEAD WE WERE WORKING ON.
3773:         HRRZ AC2,QLINK(AC1)     ; SEE IF THERE ARE ANY TASKS LEFT ON IT.
3774:         JUMPE AC2,DDEXIT        ; NO, THEY MUST HAVE ALL SUCCEEDED
3775:         HRLI AC2,DDREQ          ; YES, PUT IN A CLOCK REQUEST TO REQUEUE THEM
3776:         CONO PI,PIOFF           ; THIS WAY, THEY WILL GET TRIED AGAIN
3777:         IDPB AC2,CLKQ
3778:         CONO PI,PION
3779: DDEXIT: PUSHJ P,GIVQ            ; RELEASE THE FRAME HEADER
3780:         SKIPE AC1,DDQUE         ; SEE IF THERE IS ANOTHER FRAME
3781:         JRST NEWFRM             ; YES, DO IT.
3782:         SETZM DDRUN             ; NO, DIE QUIETLY
3783:         CONO DDD,RESET          ; CLEAR OUT THE BEAST
3784:         MOVE TAC,DDSTAC         ; RESTORE ALL OUR ACCUMULATORS
3785:         MOVE AC1,DDSAC1
3786:         MOVE AC2,DDSAC2
3787:         MOVE AC3,DDSAC3
3788:         MOVE DAT,DDSDAT
3789:         EXCH P,APRPDL(PID)
3790:         JSR DDRTN               ; RETURN TO LOSER
    DPYSER page# 0094 next  prev
3792: ; THIS ROUTINE IS CALLED AT CLOCK LEVEL WITH A LIST OF TASKS THAT
3793: ; TIMED OUT OR LOST IN SOME OBSCURE WAY. WE JUST REQUEUE THEM AND
3794: ; TRY AGAIN.
3795: 
3796: DDREQ:  HRRZ AC1,DAT            ; PICK UP THE TASK LIST
3797: DDREQ1: HRRZ DAT,QLINK(AC1)     ; GET ADDRESS OF NEXT BLOCK ON LIST
3798:         SOSG QTIME(AC1)         ; HAVE WE TRIED TOO MANY TIMES
3799:         JRST DDREQ2             ; YES, DON'T REQUE IT.
3800:         PUSHJ P,REQBLK          ; REQUE THE TASK
3801: DDREQ3: JUMPE DAT,CPOPJ         ; IF NO MORE TASKS, LEAVE
3802:         MOVE AC1,DAT
3803:         JRST DDREQ1
3804: 
3805: DDREQ2: MOVE TAC,AC1
3806:         PUSHJ P,DEQWAK          ; WAKE UP CALLER
3807:         JRST DDREQ3
    DPYSER page# 0095 next  prev
3809: ; THIS ROUTINE TAKES A TASK OUT OF THE QUEUE AND WAKES UP ANYONE IF
3810: ; IT IS SUPPOSED TO.
3811: 
3812: DEQ:    ;SOSGE NDDQUE           ; NOTE ONE MORE GONE FROM QUEUE
3813:         ;SETZM NDDQUE           ; DON'T LET IT GET NEGATIVE
3814:         MOVE AC2,QLINK(TAC)     ; PICK UP ADDRESS OF SUCCESSOR
3815:         TRNE AC2,-1             ; IS THERE ANYONE HOME?
3816:         HLLM AC2,QLINK(AC2)     ; YES, MAKE REVERSE LINK OF SUCCESSOR POINT TO OUR PREDECESSOR
3817:         MOVSS AC2               ; SAME DEAL FOR OTHER SIDE
3818:         TRNE AC2,-1             ; ANYONE HOME?
3819:         HLRM AC2,QLINK(AC2)     ; MAKE FORWARD LINK OF PREDECESSOR POINT TO SUCCESSOR
3820: DEQWAK: SKIPE QCOUNT(TAC)       ; IS THERE A COUNT WORD SOMEWHERE?
3821:         SOSLE @QCOUNT(TAC)      ; YES, COUNT IT DOWN.
3822:         JRST DEQ1               ; NO COUNT OR COUNT NOT EXPIRED
3823:         SKIPN AC1,QWAKE(TAC)    ; PICK UP WAKEUP WORD
3824:         JRST DEQ1               ; IF NONE THERE, DON'T BOTHER
3825:         TDNE AC1,[-100]         ; IS IT A JOB NUMBER?
3826:         JRST DEQ2               ; NO, MUST BE CLOCK REQUEST
3827:         SKIPL JBTSTS(AC1)
3828:         JRST DEQ1               ;DON'T REQUE IF ↑C
3829:         HLRZ AC2,(TAC)
3830:         HRRE AC2,PRGJMP(AC2)    ;CHECK WAIT FLAG
3831:         JUMPGE AC2,DEQ1         ;NOT WAITING - DON'T REQUE
3832:         MOVNI AC2,RUNQ          ; IS JOB NUMBER, PUT THIS JOB IN THE RUN QUEUE
3833:         MOVEM AC2,JOBQUE(AC1)
3834:         MOVEI AC1,QJOB(AC1)
3835:         CONO PI,PIOFF
3836:         SKIPE (AC1)
3837:         JRST .+3
3838:         EXCH AC1,QJOB
3839:         HRROM AC1,@QJOB
3840:         CONO PI,PION
3841:         JRST DEQ1
3842: 
3843: DEQ2:   CONO PI,PIOFF
3844:         IDPB AC1,CLKQ
3845:         CONO PI,PION
3846: DEQ1:   MOVE AC1,TAC            ; PUT TASK BLOCK ADDRESS IN AC1 FOR THE FOLLOWING ROUTINE
3847: GIVQ:   PUSHJ P,SFSGIV
3848:         DDFS
3849:         POPJ P,
    DPYSER page# 0096 next  prev
3851: ; PAGE PRINTER TRANSFERS
3852: 
3853: PPXFR:  SKIPL AC1,HEDPTR(DAT)   ;LET'S SEE IF THIS IS A LEGAL PP
3854:         CAML AC1,RMEMSI
3855:         JRST ILLPP              ;GARBAGEY HEADER ADR
3856:         HLRZ AC1,PRGNUM(AC1)
3857:         LDB AC3,[241000,,DDCW(DAT)]
3858:         CAIE AC1,(AC3)
3859:         JRST ILLPP              ;DD CHNL DOESN'T MATCH
3860:         SETZM DDSAV(DAT)        ; INITIALIZE THE SAVE WORD
3861:         SKIPE PPINV(DAT)        ; IS THE TEXT VALID?
3862:         JRST PPXFR2             ; NO, FLUSH THE TRANSFER
3863:         PUSHJ P,POSLIN          ; GET NUMBER OF FIRST LINE ON PAGE IN AC3
3864:         HLRE AC1,QLINE(TAC)     ; PICK UP FIRST LINE OF TRANSFER
3865:         CAMG AC1,VPOS(DAT)      ; IS FIRST LINE OF TRANSFER BELOW CURRENT SCREEN?
3866:         CAMGE AC1,AC3           ; OR ABOVE FIRST LINE OF SCREEN?
3867:         JRST PPXFR2             ; YES, ABORT TRANSFER
3868:         HRRE AC1,QLINE(TAC)     ; SAME FOR LAST LINE OF TRANSFER
3869:         CAMG AC1,VPOS(DAT)
3870:         CAMGE AC1,AC3
3871:         JRST PPXFR2
3872:         HLRE AC3,QLINE(TAC)     ; PICK UP STARTING LINE NUMBER
3873:         SKIPG AC3               ; IF IT IS ABOVE SCREEN . . .
3874:         MOVEI AC3,1             ; USE TOP OF SCREEN AS FIRST LINE
3875:         MOVEI AC1,-1(AC3)       ; GET NORMALIZED LINE NUMBER
3876:         PUSHJ P,GLNADR          ; GET LINE ADDRESS FROM LINE NUMBER
3877:         ADD AC2,[XWD DISJMP,1]  ; BUMP PAST CRLF ON LAST LINE
3878:         MOVSM AC2,DDCW+2(DAT)   ; PLACE JUMP TO TEXT IN CODE
3879:         IMULI AC1,=12
3880:         SKIPE QFIELD(TAC)       ; CHECK THE FIELD
3881:         ORI AC1,1               ; PUT IT OUT ON THE ODD FIELD THIS TIME
3882:         DPB AC1,[POINT 4,DDCW+1(DAT),23]
3883:         LSH AC1,-4
3884:         DPB AC1,[POINT 5,DDCW+1(DAT),15]
3885:         HRRE AC3,QLINE(TAC)     ; PICK UP FINISHING LINE OF TRANSFER
3886:         CAILE AC3,=40           ; IS IT OFF THE SCREEN?
3887:         MOVEI AC3,=40           ; YES, USE THE LAST LINE ON THE SCREEN
3888:         CAMN AC3,VPOS(DAT)      ; IS THIS THE SAME AS THE VERTICAL POSITION OF THE PAGE PRINTER
3889:         JRST PPXFR4             ; YES, NO NEED TO SAVE ANY WORDS.
3890:         ADDI AC3,1              ; BUMP LINE POINTER BY ONE TO GET TO THE END OF THIS LINE
3891:         PUSHJ P,GLNADR          ; PICK UP THE ADDRESS OF THE END OF THAT LINE
3892:         MOVE AC1,(AC2)          ; PICK UP THE WORD AT THE END OF THE LINE
3893:         MOVEM AC2,DDSPT(DAT)    ; SAVE THE POINTER TO THE SAVED WORD.
3894:         MOVEM AC1,DDSAV(DAT)    ; STORE IT IN THE PAGE PRINTER CONTROL BLOCK
3895:         MOVSI AC1,DDSAV(DAT)    ; PICK UP ADDRESS OF SAVED WORD
3896:         HRRI AC1,DISJMP         ; PLACE A JUMP TO IT WHERE IT WAS IN THE BUFFER
3897:         MOVEM AC1,(AC2)
    DPYSER page# 0097 next  prev
3899: PPXFR3: MOVEI AC1,DDCW(DAT)     ; PICK UP ADDRESS OF START OF TRANSFER
3900:         CONO DDD,USUAL          ; SET UP THE DATA DISC
3901:         DATAO DDD,AC1           ; SEND OUT THE ADDRESS
3902:         PUSHJ P,ISYNC           ; WAIT FOR IT
3903:         JFCL
3904:         JRST PPXFR1             ; LOSE BIG, LEAVE THE TRANSFER IN THE QUEUE
3905: PPXFR2: PUSHJ P,DEQ             ; WIN, TAKE THE TASK OUT OF THE QUEUE
3906: PPXFR1: MOVSI AC1,040000        ; CLEAR THE 'NO ERASE' BIT IF WE SET IT
3907:         ANDCAM AC1,DDCW(DAT)
3908:         SKIPE AC1,DDSAV(DAT)    ; RESTORE THE SAVED WORD, IF THERE IS ANY
3909:         MOVEM AC1,@DDSPT(DAT)
3910:         JRST RESCAN
3911: 
3912: PPXFR4: MOVSI AC1,040000        ; IF WE ARE AT THE BOTTOM OF THE SCREEN,
3913:         CAMN AC2,VPOS(DAT)      ; THEN DON'T ERASE THE REST OF THE LINE
3914:         ORM AC1,DDCW(DAT)       ; BECAUSE WE MIGHT BE ERASING PART OF THE LINE EDITOR
3915:         JRST PPXFR3             ; THE LINE EDITOR WILL ERASE THE REST OF THE LINE ITSELF
3916: 
3917: ILLPP:  PUSHACS
3918:         PUSHJ P,DISDAT
3919:         PUSHJ P,DISMES
3920:         ASCIZ /ILLEGAL PP AT PPXFR
3921: /
3922:         DEBCHE
3923:         POPACS
3924:         PUSHJ P,DEQ
3925:         JRST RESCAN
    DPYSER page# 0098 next  prev
3927: ; HERE IS THE ERASE CODE.
3928: 
3929: ERASE:  HLRE AC2,QLINE(TAC)     ; PICK UP STARTING ADDRESS
3930:         SKIPG AC2               ; IS IT ABOVE THE SCREEN?
3931:         MOVEI AC1,1             ; YES, START FROM LINE 1
3932:         MOVEI AC1,-1(AC2)       ; CONVERT IT TO HARDWARE FORM
3933:         IMULI AC1,=12
3934:         SKIPE QFIELD(TAC)       ; WHAT FIELD DOES THIS GO OUT ON?
3935:         ORI AC1,1               ; ODD FIELD
3936:         DPB AC1,[POINT 4,DDERRS+1,23]
3937:         LSH AC1,-4
3938:         DPB AC1,[POINT 5,DDERRS+1,15]
3939:         MOVE AC1,DDCW(DAT)      ; PICK UP FUNCTION SELECT
3940:         MOVEM AC1,DDERRS        ; USE IT FOR THE ERASURE
3941:         HRRE AC1,QLINE(TAC)     ; GET ENDING LINE NUMBER
3942:         CAILE AC1,=40           ; IF OFF THE BOTTOM OF THE SCREEN . . .
3943:         MOVEI AC1,=40           ; THEN USE THE NUMBER OF THE LAST LINE ON THE SCREEN
3944:         SUB AC2,AC1             ; GET THE NUMBER OF LINES TO BE ERASED
3945:         ADD AC2,[XWD DISJMP,DDCRLF+=39]
3946:         MOVSM AC2,DDERRS+2      ; JUMP TO THE POSITION IN THE ERASURES THAT CORRESPONDS TO THAT MANY LINES.
3947:         CONO DDD,USUAL
3948:         DATAO DDD,[DDERRS]
3949: CWAIT:  PUSHJ P,ISYNC
3950:         JFCL
3951:         JRST RESCAN             ; LOSE BIG, JUST DO ANOTHER TASK
3952:         PUSHJ P,DEQ             ; WIN, TAKE US OUT OF THE QUEUE
3953:         JRST RESCAN             ; AND GO DO SOMETHING ELSE.
    DPYSER page# 0099 next  prev
3955: ; CURSOR TRANSFERS.
3956: 
3957: CURSOR: MOVE AC1,[POINT 36,CURZWD-1,35]
3958:         MOVEM AC1,CZPNT         ; INITIALIZE LIST OF WORDS IN CURSOR CODE WE USED
3959:         MOVE AC1,DDCW(DAT)      ; PICK UP COMMAND WORD WITH FUNCTION SELECT IN IT
3960:         TLO AC1,002000          ; MAKE IT A GRAPHICS WORD
3961:         MOVEM AC1,DDCURS        ; AND USE IT AS OUR SELECT WORD
3962:         HLRE AC1,QLINE(TAC)     ; PICK UP LINE NUMBER OF TRANSFER
3963:         JUMPLE AC1,CDX          ; IF OUT OF BOUNDS, FORGET IT
3964:         CAILE AC1,=40           ; IS IT OFF THE BOTTOM OF THE SCREEN?
3965:         JRST CDX                ; YES, RESTORE CURSOR CODE AND LEAVE
3966:         IMULI AC1,=12
3967:         SUBI AC1,2              ; BACK UP THE LINE TO BEFORE THE NEXT TEXT
3968:         DPB AC1,[POINT 4,DDCURS+1,23]
3969:         LSH AC1,-4
3970:         DPB AC1,[POINT 5,DDCURS+1,15]
3971:         HLRE AC1,QHPOS(TAC)     ; PICK UP FIRST HORIZONTAL POSITION
3972:         SKIPL AC1               ; IS THERE ANY?
3973:         PUSHJ P,CMAKE           ; YES, MAKE UP CODE FOR IT
3974:         HRRE AC1,QHPOS(TAC)     ; PICK UP SECOND HORIZONTAL POSITION
3975:         SKIPL AC1               ; IS THERE ANY?
3976:         PUSHJ P,CMAKE           ; YES, COMPILE IT.
3977:         CONO DDD,USUAL
3978:         DATAO DDD,[DDCURS]
3979:         PUSHJ P,ISYNC
3980:         JFCL
3981:         JRST CURS2              ; UNFORGIVABLE LOSSAGE, TRY AGAIN LATER
3982: CDX:    PUSHJ P,DEQ             ; REMOVE US FROM THE QUEUE
3983: CURS2:  HRRZ AC1,CZPNT          ; PICK UP POINTER TO CURSOR CODE ADDRESSES
3984:         MOVEI AC2,2             ; PICK UP A BLANK GRAPHICS WORD
3985: CURS1:  CAIGE AC1,CURZWD        ; ARE WE BACK TO THE START YET?
3986:         JRST RESCAN             ; YES, GO BACK FOR ANOTHER TASK
3987:         MOVEM AC2,@(AC1)        ; NO, CLEAR OUT THIS CURSOR
3988:         SOJA AC1,CURS1          ; BACK UP FOR THE NEXT ONE, IF ANY.
    DPYSER page# 0100 next  prev
3990: ; THIS ROUTINE MAKES UP THE CODE FOR A CURSOR.
3991: 
3992: CMAKE:  IMULI AC1,6             ; CONVERT TO NUMBER OF BITS FROM LEFT MARGIN
3993:         ADDI AC1,1              ; THE UNIVERSAL FUDGE FACTOR STRIKES AGAIN!
3994:         LDB AC2,[POINT 5,AC1,35]
3995:         LSH AC1,-5              ; IT IS NOW CONVERTED TO NUMBER OF WORDS AND BITS WITHIN LAST WORD
3996:         ADDI AC1,DDCURS+2       ; MAKE UP POINTER TO THE GRAPHICS WORD IN QUESTION
3997:         IDPB AC1,CZPNT          ; SAVE THIS ADDRESS SO WE CAN ZERO IT WHEN WE LEAVE
3998:         MOVSI AC3,360000        ; SHIFT OVER A CURSOR
3999:         MOVNS AC2
4000:         LSH AC3,(AC2)
4001:         ANDCMI AC3,17           ; ZERO OUT POSSIBLE OVERFLOW INTO OPCODE
4002:         ORM AC3,(AC1)           ; PUT THOSE BITS INTO THE LOCATION WE CALCULATED
4003:         CAMLE AC2,[-=28]        ; IS THERE TWO WORDS WORTH?
4004:         POPJ P,                 ; NO, RETURN NOW
4005:         ADDI AC1,1              ; YES, BUMP POINTER
4006:         IDPB AC1,CZPNT          ; AND SAVE IT
4007:         MOVSI AC3,360000        ; MAKE UP ANOTHER CURSOR
4008:         LSH AC3,=32(AC2)
4009:         ORM AC3,(AC1)           ; SET IT IN PLACE
4010:         POPJ P,
    DPYSER page# 0101 next  prev
4012: ; LINE EDITOR TRANSFERS
4013: 
4014: LEXFR:  HRRZ AC1,CURPP(DAT)     ; PICK UP PAGE PRINTER CONTROL BLOCK ADDRESS
4015:         SKIPE PPNQT(AC1)        ; IS THERE ANYTHING NOT COUNTED IN THE QUEUE
4016:         JRST LEXFR2
4017:         SKIPN PPENQ(AC1)        ; IF ANYONE THERE, ABORT THE TRANSFER
4018:         SKIPE LEINV(DAT)        ; IS THE BUFFER VALID?
4019:         JRST LEXFR2             ; NO, SET 'MISSED IT' FLAG AND QUIT
4020:         HLRE AC1,QLINE(TAC)     ; PICK UP LINE NUMBER
4021:         JUMPLE AC1,LEXFR1       ; IF STARTING LINE IS ABOVE SCREEN, FORGET IT
4022:         SUBI AC1,1              ; OTHERWISE WE WILL SHOW AS MUCH AS WE CAN
4023:         IMULI AC1,=12           ; CONVERT TO DD FLAVOR LINE ADDRESS
4024:         SKIPE QFIELD(TAC)       ; WHAT FIELD DOES THIS TRANSFER WANT TO GO TO?
4025:         ORI AC1,1               ; ODD FIELD, MAKE LINE ADDRESS ODD
4026:         DPB AC1,[POINT 4,LEBFR+1,23]
4027:         LSH AC1,-4
4028:         DPB AC1,[POINT 5,LEBFR+1,15]
4029:         MOVE AC1,FCPOS(DAT)     ; PICK UP NUMBER OF CHARACTERS IN BUFFER
4030:         MOVE AC2,PRGNUM(DAT)    ; GET DPY NUMBER
4031:         SKIPL LETAB(AC2)        ; IS THE LINE EDITOR INITIALIZED?
4032:         SETZ AC1,               ; NO, NO CHARACTERS IN IT
4033:         JUMPN AC1,LEXFR3        ; IF SOME CHARACTERS THERE, WE ARE SET.
4034:         MOVE AC1,[ASCID /  
4035: /]
4036:         MOVEM AC1,LEBFR+2       ; IF NONE, CLEAR OUT THE LINE WITH A SPACE AND A CRLF
4037: LEXFR4: MOVE AC1,CURPP(DAT)     ; PICK UP ADDRESS OF PAGE PRINTER CONTROL BLOCK
4038:         MOVE AC2,DDCW(AC1)      ; GET FUNCTION SELECT WORD
4039:         MOVEM AC2,LEBFR         ; USE IT FOR US
4040:         MOVEI AC2,2             ;COLUMN OFFSET
4041:         SKIPGE LEPOS(DAT)
4042:         JRST .+3                ;THAT'S THE POS IF LEYPOS IN EFFECT
4043:         ADD AC2,DPHPOS(AC1)
4044:         ADD AC2,LNLNGT(AC1)     ;ELSE FOLLOW PP
4045:         DPB AC2,[POINT 8,LEBFR+1,7]
4046:         CONO DDD,USUAL          ; START UP THE BEAST
4047:         DATAO DDD,[LEBFR]       ; AND AWAY WE GO . . .
4048:         PUSHJ P,ISYNC
4049:         JRST RESCAN
4050:         JRST RESCAN
4051:         JRST LEXFR1             ; WIN, DEQUEUE US AND LEAVE
    DPYSER page# 0102 next  prev
4053: ; WE GET HERE WHEN THE TRANSFER IS DONE OR ABORTED.
4054: 
4055: LEXFR2: SETOM LEMISS(DAT)       ; NOTE THAT WE MISSED THIS TRANSFER DUE TO BUFFER INVALID
4056: LEXFR1: PUSHJ P,DEQ             ; REMOVE US FROM THE QUEUE
4057:         HRRZ AC2,CURPP(DAT)     ; PICK UP PAGE PRINTER CONTROL BLOCK ADDRESS
4058:         HRRZ AC3,LLW(AC2)       ; PICK UP LAST LINE TRANSFERRED
4059:         CAME AC3,VPOS(AC2)      ; IS THE PAGE PRINTER UP TO DATE?
4060:         SKIPE PPENQ(AC2)        ; YES, IS IT BUSY NOW?
4061:         JRST RESCAN             ; UP TO DATE OR BUSY
4062:         HRLI AC2,REFLINE        ; NOT UP TO DATE AND NOT BUSY, REFRESH ITS LINE
4063:         CONO PI,PIOFF           ; PLANT A CLOCK REQUEST
4064:         IDPB AC2,CLKQ
4065:         CONO PI,PION
4066:         JRST RESCAN
4067: 
4068: LEXFR3: MOVEI AC1,LEBUF(DAT)    ; GET THE ADDRESS OF THE LINE EDITOR TEXT
4069:         HRLI AC1,DISJMP         ; MAKE A JUMP TO IT
4070:         MOVSM AC1,LEBFR+2       ; AND PUT IT IN THE STARTUP CODE
4071:         JRST LEXFR4
    DPYSER page# 0103 next  prev
4073: ; WHOLE SCREEN ERASURE AND AVAILABLE MESSAGE
4074: 
4075: WSE:    MOVE AC1,CURPP(DAT)     ; PICK UP ADDRESS OF PAGE PRINTER CONTROL BLOCK
4076:         MOVE AC2,DDCW(AC1)      ; GET FUNCTION SELECT WORD
4077:         MOVEI AC3,13            ; MAKE IT INTO AN ERASE REQUEST
4078:         MOVEM AC2,WSERC+1       ; PUT DOWN NORMAL COPY FIRST
4079:         TLNE AC2,(1B5)          ; WHAT FLAVOR?
4080:         ORI AC3,4
4081:         DPB AC3,[POINT 8,AC2,7]
4082:         MOVEM AC2,WSERC
4083:         CONO DDD,USUAL
4084:         DATAO DDD,[WSERC]
4085:         JRST CWAIT              ; GO WAIT FOR TRANSFER AND LEAVE
4086: 
4087: 
4088: ; HERE IS THE WHO LINE ROUTINE.
4089: 
4090: WHOWRT:
4091:         MOVE    AC1,QHPOS(TAC)  ; PICK UP SAVED DPY NUMBER
4092:         CAIE    AC1,DDAVLU      ;AVAILABLE CHANNEL?
4093:         JRST WHOWR2             ;NO
4094:         MOVEI DAT,AVLWHO        ;GET PTR TO DD PROG
4095:         MOVE    AC1,AVLVP       ;GET DD CW TO RANDOM POSITION ON SCREEN
4096:         JRST WHOWR3
4097: WHOWR2: SKIPN   FRETAB(AC1)     ; IS OUR FREE STORAGE STILL HERE?
4098:         JRST    WHOWR1          ; NO, EXIT NOW
4099:         MOVE    AC1,[CW 3,2,4,0,5,0]
4100: WHOWR3: SKIPE   QFIELD(TAC)
4101:         ORI     AC1,1B23
4102:         MOVEM   AC1,1(DAT)      ; PUT IT IN THE DD PROG
4103:         MOVEI   AC1,3(DAT)      ; PUT RETURN ADDRESS INTO SYSTEM WHO LINE DPY CODE
4104:         HRLM    AC1,DDDRET
4105:         CONO    DDD,USUAL
4106:         DATAO   DDD,DAT
4107:         PUSHJ   P,ISYNC
4108:         JFCL
4109:         JFCL
4110:         MOVE    AC1,QHPOS(TAC)  ; GET DPY NBR/AVL CODE BACK
4111:         CAIE    AC1,DDAVLU      ; ARE WE DOING THE AVL CHN?
4112:         JRST    WHOWR1          ; NO
4113:         HRLZI   AC2,20000       ; YES, TURN OFF ERASE BIT IN CW
4114:         ANDCAM  AC2,(DAT)
4115: WHOWR1: PUSHJ   P,DEQ
4116:         AOS     WHOPTR          ;COUNT ANOTHER FIELD DONE.
4117:         JRST    RESCAN
    DPYSER page# 0104 next  prev
4119: ; USER DATA DISC PROGRAM . . .
4120: 
4121: POG:    HLRZ AC1,QHPOS(TAC)     ;ADR OF CELL TO SET FIELD
4122:         JUMPE AC1,POG2          ;NONE
4123:         HRLI AC1,140100         ;MAKE BYTE PNTR TO FIELD BIT
4124:         MOVE AC2,QFIELD(TAC)
4125:         DPB AC2,AC1             ;STORE FIELD
4126: POG2:   CONO DDD,USUAL!EXECM
4127:         MOVEI AC1,PRGCW(DAT)    ; PICK UP ADDRESS OF START OF PROGRAM
4128:         DATAO DDD,AC1           ; SEND IT OUT
4129: ;DONT   MOVE AC1,TIME
4130: ;SAVE   SKIPN DPGTIM(DAT)
4131: ;TIME   MOVEM AC1,DPGTIM(DAT)   ; NOTE TIME PROGRAM WENT OUT
4132:         PUSHJ P,ISYNC
4133:         JFCL
4134:         JFCL
4135:         HRRZ AC1,QHPOS(TAC)     ;ADR OF LOSER'S COUNT CELL
4136:         JUMPE AC1,.+2           ;NONE
4137:         SOS (AC1)
4138:         MOVE AC1,QWAKE(TAC)     ; PICK UP JOB NUMBER
4139:         SOS JBTGLU(AC1)         ; RELEASE US FROM CORE
4140: IFN FTSTAT,<
4141:         PUSH P,J
4142:         MOVE J,AC1
4143:         PUSHJ P,GLUSTT
4144:         POP P,J
4145: >
4146:         SKIPN DPRLSF(DAT)       ; ARE WE A DETACHED JOB?
4147:         JRST POG1               ; NO, LEAVE
4148:         HRRZI AC1,(DAT)         ; PICK UP ADDRESS OF DPY PROGRAM HEADER TO BE RETURNED
4149:         HRLI AC1,POGCLK         ; RETURN IT AT FREE STORAGE
4150:         CONO PI,PIOFF
4151:         IDPB AC1,CLKQ
4152:         CONO PI,PION
4153: POG1:   PUSHJ P,DEQ             ; REMOVE THE TASK
4154:         JRST RESCAN
4155: 
4156: POGCLK: HRRZ AC1,DAT            ; RETURN PROGRAM HEADER ITSELF
4157:         JRST FSGIVE
4158: 
4159: ; ROUTINE TO PRINT 'PAGE PRINTER HOLDING' MESSAGE
4160: 
4161: PPSTAR: MOVE AC1,DDCW(DAT)
4162:         MOVEM AC1,DDSTRS
4163:         SETZ AC1,
4164:         SKIPE QFIELD(TAC)
4165:         MOVEI AC1,1             ; SET LINE ADDRESS ODD
4166:         DPB AC1,[POINT 1,DDSTRS+1,23]
4167:         CONO DDD,USUAL
4168:         DATAO DDD,[DDSTRS]
4169:         JRST CWAIT
    DPYSER page# 0105 next  prev
4171: ; ALL TRANSFERS COME BACK TO HERE WHEN THEY ARE DONE OR TIMED OUT
4172: 
4173: ISYNC:  POP P,DDDSP             ; SAVE RETURN ADDRESS
4174:         MOVEI AC3,6             ; TIMEOUT IF NO INTERRUPT IN 8 TIX
4175:         MOVEM AC3,DDCNT         ; STORE IN THE COUNT WORD
4176:         MOVEM DAT,DDCUR         ; SAVE CONTROL BLOCK ADDRESS
4177:         MOVEM TAC,DDCURT        ; SAVE TASK BLOCK ADDRESS TOO.
4178:         MOVE DAT,DDSDAT         ; RESTORE ACCUMULATORS
4179:         MOVE AC1,DDSAC1
4180:         MOVE AC2,DDSAC2
4181:         MOVE AC3,DDSAC3
4182:         MOVE TAC,DDSTAC
4183:         EXCH P,APRPDL(PID)      ; RESTORE THE PDL
4184:         JSR DDRTN               ; AND RETURN TO WHEREVER
4185: 
4186: ↑DDINT: SKIPN DDRUN
4187:         JRST DDILL
4188:         MOVEM AC3,DDSAC3        ; SAVE ONE ACCUMULATOR
4189:         MOVEI AC3,DDIXIT        ; MAKE US RETURN THROUGH CH3 NEXT TIME OUT
4190:         MOVEM AC3,DDRET         ; SO WE CAN RE-ENABLE THE CHANNEL
4191:         MOVE AC3,DDDSP          ; PICK UP RETURN ADDRESS
4192:         EXCH PID,APRID+P1PID    ; PICK UP PROCESSOR IDENTIFICATION
4193:         CONSZ 510,DDNXM
4194:         JRST DDNX
4195:         CONSO 510,LOSE          ; DID DD MISS A WORD FROM MEMORY?
4196:         JRST DDINT1             ; NO, GO AHEAD
4197: DDINT2: CONO 510,RESET          ; YES, STOP IT AMID-TRANSFER
4198:         JRST DDCMR
    DPYSER page# 0106 next  prev
4200: ; DATA DISC NON-EX MEM TYPEOUT, ACCUMULATOR SAVER, AND CLOCK TIMEOUT ROUTINES
4201: 
4202: DDNX:   EXCH P,APRPDL(PID)
4203:         PUSHACS
4204:         PUSHJ P,DISDATE
4205:         PUSHJ P,DISERR
4206:         [ASCIZ /DATA DISC NON-EX MEM
4207: /]
4208:         -1
4209:         POPACS
4210:         EXCH P,APRPDL(PID)
4211:         JRST DDINT2
4212: 
4213: 
4214: DDINT1: ADDI AC3,2              ; ALL OK, BUMP RETURN ADDRESS TO SUCCESS RETURN
4215: DDCMR:  MOVEM DAT,DDSDAT        ; SAVE THE REST OF THE ACCUMULATORS
4216:         MOVEM TAC,DDSTAC
4217:         MOVEM AC1,DDSAC1
4218:         MOVEM AC2,DDSAC2
4219:         EXCH P,APRPDL(PID)
4220:         MOVE DAT,DDCUR          ; PICK UP ADDRESS OF CONTROL BLOCK
4221:         MOVE TAC,DDCURT         ; PICK UP ADDRESS OF TASK BLOCK
4222:         HRLOI AC2,377777        ; SET COUNT TO MAXIMUM WHEN NO TRANSFER IN PROGRESS
4223:         MOVEM AC2,DDCNT
4224:         JRST (AC3)              ; RETURN TO LOSER
4225: 
4226: ↑DDCLK: MOVEM AC3,DDSAC3        ; STORE THIS ACCUMULATOR
4227:         MOVEI AC3,APRADD        ; MAKE US RETURN TO APRSER
4228:         MOVEM AC3,DDRET         ; NEXT TIME OUT
4229:         MOVE AC3,DDDSP          ; PICK UP RETURN ADDRESS
4230:         ADDI AC3,1              ; BUMP BY ONE TO NOTE THAT CLOCK TIMEOUT HAS HAPPENED
4231:         CONO 510,RESET          ; TIMED OUT, MUST BE HUNG. CLEAR IT OUT.
4232:         JRST DDCMR
4233: 
4234: DDIXIT: EXCH PID,APRID+P1PID    ; RESTORE PID
4235:         JEN @CH3                ; DISMISS CHANNES
    DPYSER page# 0107 next  prev
4237: ; WE GET HERE IF WE GET AN INTERRUPT FROM THE DATA DISK AND
4238: ; OUR MAGIC FLAG INDICATES THAT NO TRANSFER WAS IN PROGRESS.
4239: 
4240: DDILL:  EXCH P,APRPDL+P1PID     ; GET A PUSHDOWN LIST
4241:         PUSHACS                 ; SAVE OUR ACCUMULATORS
4242:         PUSHJ P,DISMES          ; GIVE HARDWARE PEOPLE NASTY MESSAGE!
4243:         ASCIZ/
4244: UNEXPECTED DATA DISC INTERRUPT!!!
4245: /
4246:         CONO 510,RESET          ; CLEAR ITS MIND
4247:         POPACS                  ; RESTORE OUR ACCUMULATORS
4248:         EXCH P,APRPDL+P1PID     ; RESTORE P
4249:         JEN @CH3
    DPYSER page# 0108 next  prev
4251: ;DEFINITIONS FOR DATA DISC ALLOCATION
4252: 
4253: DDLNK←←<600,,DDTAB>     ;LINK OUT
4254: DDALST←←<60600,,DDTAB>  ;ALLOC LIST (PERMANENT)
4255: ↑DDUSR←←<221000,,DDTAB> ;USER FLD
4256: DDELNK←←40              ;LIST TERMINATOR (ZERO IS LEGAL VAL)
4257: DDCLST←←<600,,JB2SWP>   ;LIST OF CHANNELS OWNED BY JOB
4258: 
4259: DDGBIT←←100             ;"GET" BIT IN UUO
4260: DDSBIT←←200             ;"STATUS" BIT IN UUO
4261: DDGMOD←←50300           ;WHOLE MODE FLD
4262: ↑DDANYW←←200000         ;LET ANYONE WRITE
4263: DDSMSK←←600000          ;MASK FOR USER SETTABLE BITS
4264: DDUSR2←←222000          ;TO SET USER & CLEAR EXTRA BITS
4265: 
4266: ;SPECIAL USER CODES
4267: 
4268: ↑DDAVLU←←200            ;AVAILABLE CHANNEL
4269: ↑DDDETU←←201            ;DETACHED FROM SYS
4270: 
4271: ;DEFINITIONS FOR VIDEO SWITCH ROUTINES
4272: 
4273: VDOP←←330300            ;OPCODE FLD FOR UUO
4274: VDPERM←←400000          ;"PERMANENT" BIT - MUST BE SIGN
4275: VDXBIT←←400             ;"EXTRA CHANNEL" BIT
    DPYSER page# 0109 next  prev
4277: ;INITIALIZATION FOR DATA DISC ALLOCATION AND VIDEO SWITCH
4278: DDINI:  SETOM DDTAB
4279:         MOVE TAC,[DDTAB,,DDTAB+1]
4280:         BLT TAC,DDTAB+DDELNK            ;CLEAR TABLE FOR DUPLICATION TEST
4281:         MOVE TAC,[440600,,DDLIST]
4282:         MOVEI AC2,DDELNK
4283: DDINI1: ILDB AC1,TAC
4284:         SKIPL DDTAB(AC1)
4285:         JRST 4,.                ;OOPS - WE'VE BEEN HERE BEFORE
4286:         MOVEM AC2,DDTAB(AC1)    ;INITIALIZE DDTAB WITH ALLOC LIST & FREE LIST
4287:         DPB AC1,[DDALST(AC2)]
4288:         MOVEI AC2,(AC1)
4289:         CAIE AC1,DDELNK
4290:         JRST DDINI1
4291:         MOVEI J,JOBN-1
4292:         MOVEI TAC,
4293:         DPB TAC,[DDCLST(J)]     ;INIT JOB CHNL LISTS
4294:         SOJG J,.-1
4295:         MOVEI TAC,40
4296:         MOVEM TAC,DDFCNT        ;INIT FREE CHNL COUNT
4297:         MOVSI TAC,200
4298:         HRR TAC,AVLCHN
4299:         PUSHJ P,DDCGET          ;GET CHN FOR AVAIL MSG
4300:         JRST 4,.
4301:         MOVEI AC1,(TAC)
4302:         PUSHJ P,VDBIT
4303:         MOVEM AC3,AVLBIT
4304:         MOVSI AC1,-DDNUM
4305: DDINI2: MOVEM AC3,VDMAP(AC1)    ;MAP EVERYONE TO MSG
4306:         CONO VDS,DPYNUM(AC1)
4307:         DATAO VDS,AC3
4308:         AOBJN AC1,DDINI2
4309:         DPB TAC,[POINT 8,AVLWHO,15]
4310:         PUSHJ P,WHOSYS          ;INITIALIZE SYSTEM WHOLINE
4311:         SETOM WHOKLU            ;THIS MAKES WHOSER PUT THE MSG OUT
4312:         POPJ P,
4313: ↑DDAVST:
4314:         MOVEI AC2,1
4315:         SKIPN DDFCNT            ;ARE THERE ANY CHANNELS FREE?
4316:         MOVE AC2,[DDUNMS,,DISJMP]       ;NO MAKE UNAVAIL MESSAGE HAPPEN
4317:         SKIPN MAINTMODE
4318:         SKIPE TTYLOK
4319:         MOVE AC2,[XWD DDDMES,DISJMP]
4320:         MOVEM AC2,DDWMES
4321: 
4322:         DATAI DSK,AC1           ;CHOOSE A (RANDOM) NUMBER, ANY NUMBER
4323:         ADD AC1,TIME
4324:         IDIVI AC1,300
4325:         ADDI AC2,10
4326:         MOVEI AC1,(AC2)
4327:         DPB AC2,[150300,,AVLVP] ;STORE LOW ORDER PART
4328:         LSH AC2,-3              ;REMOVE LOW ORDER PART
4329:         DPB AC2,[240500,,AVLVP] ;STORE HI PART
4330:         IDIVI AC1,=12           ;CONVERT RASTER LINE TO TEXT LINE
4331:         HRLI AC1,3(AC1)         ;AVL MSG USES 4 DIFFERENT TEXT LINES
4332:         MOVSM AC1,AVLLN
4333:         HRLZI AC2,20000
4334:         IORM AC2,AVLWHO ;TURN ON ERASE BIT TO FORCE ERASE BEFORE FIRST FIELD
4335:         POPJ P,
4336: 
4337: DDLIST: BYTE (6)37,36,35,34,33,32,31,30,27,25,24,23,7,22,11,12,26,5
4338:         BYTE (6)13,17,2,14,10,1,20,21,16,15,6,4,3,0,DDELNK
4339: 
4340: ↑VDSYNC:0↔11↔12↔13↔14↔15↔6↔7
    DPYSER page# 0110 next  prev
4342: ;ALL-PURPOSE DD CHANNEL DIDDLING UUO:
4343: ;AC31-35 = CHAN, AC30 => NO SPECIFIC CHAN (CONSOLE CHAN FOR STATUS)
4344: ;AC28-29: 0-RELEASE, 1-GET, 2-GET STATUS, 3-SET STATUS
4345: ;AC29=1 => FAILURE POSSIBLE, SKIP ON SUCCESS
4346: ;AC0 PRIVATE CHAN, SET ON GET OR SET STATUS
4347: ;REST OF LH READ-ONLY STATUS BITS, RETURNED ON SINGLE-CHAN OPS OR GETTING CHAN:
4348: ;AC10-17 USE: 0=FREE, 1-77=JOB N, 100-177=TTY N-100+DDL0, 200-377 SPECIAL
4349: 
4350: ↑DDCHAN:DPB J,[DDUSR2,,TAC]
4351:         LDB AC1,[DDGMOD,,TAC]
4352:         ANDCMI TAC,-40
4353:         PUSHJ P,@DDCDSP(AC1)
4354:         JRST STOTAC
4355:         AOS (P)
4356:         JRST STOTAC
4357: 
4358: DDCDSP: DDCREL
4359:         DDAREL
4360:         DDCGET
4361:         DDAGET
4362:         DDSGET
4363:         DDCSGT
4364:         DDSSET
4365:         DDCSST
4366: 
4367: ;RELEASE ALL CHANS OWNED BY JOB (ALSO CALLED ON RESET)
4368: 
4369: ↑DDAREL:PUSH P,TAC
4370:         LDB TAC,[DDCLST(J)]
4371:         SOJL TAC,TPOPJ
4372:         HLL TAC,(P)
4373:         MOVEI AC1,
4374:         DPB AC1,[DDCLST(J)]     ;CLEAR THE LIST HERE IN ONE SWELL FOOP
4375: DDARL1: LDB AC3,[DDLNK(TAC)]
4376:         PUSHJ P,DDREL           ;SO WE DON'T HAVE TO DO IT HERE
4377:         HRRI TAC,(AC3)
4378:         CAIE AC3,DDELNK
4379:         JRST DDARL1
4380:         JRST TPOPJ
    DPYSER page# 0111 next  prev
4382: ;RELEASE CHANNEL C(TAC)
4383: 
4384: DDCREL: LDB AC2,[DDLNK(TAC)]    ;HERE CHAN BELONGS TO JOB
4385:         LDB AC1,[DDCLST(J)]     ;& MUST BE DELINKED FROM JOB'S LIST
4386:         CAIN AC1,1(TAC)
4387:         AOJA AC2,[CAIL AC2,41
4388:                 MOVEI AC2,
4389:                 DPB AC2,[DDCLST(J)]
4390:                 JRST DDREL]
4391:         SOJL AC1,DDREL
4392: DDCRL1: LDB AC3,[DDLNK(AC1)]
4393:         CAIN AC3,(TAC)
4394:         JRST [DPB AC2,[DDLNK(AC1)]↔JRST DDREL]
4395:         MOVEI AC1,(AC3)
4396:         CAIE AC1,DDELNK
4397:         JRST DDCRL1
4398: ↑DDREL: LDB AC1,[DDUSR(TAC)]    ;ENTER TO JUST RELEASE CHANNEL
4399:         TSC AC1,TAC
4400:         TRNE AC1,377
4401:         JRST DDREL2             ;DOESN'T BELONG TO HIM
4402:         MOVEI AC1,(TAC)
4403:         AOS AC2,DDFCNT
4404:         CAIN AC2,1
4405:         SETOM WHOKLU            ;CHANGE TO AVAILABLE MESSAGE
4406:         MOVSI AC2,377
4407:         CONO PI,SCNOFF
4408:         LDB AC1,[DDALST(AC1)]
4409:         TDNE AC2,DDTAB(AC1)     ;SCAN UP ALLOC LIST (ORDERED)
4410:         JRST .-2
4411:         LDB AC2,[DDLNK(AC1)]    ;SO WE CAN PUT IN RIGHT PLACE IN FREE LIST
4412:         DPB TAC,[DDLNK(AC1)]
4413:         DPB AC2,[DDLNK(TAC)]
4414:         HRRZS DDTAB(TAC)
4415: ↑SCNONJ:CONO PI,SCNON
4416:         POPJ P,
4417: 
4418: DDREL2: TLNN TAC,300
4419:         POPJ P,                 ;JUST SOME LOSER
4420:         PUSHACS
4421:         PUSHJ P,DISERR
4422:         [ASCIZ /ILLEGAL DD RELEASE - TAC=/]
4423:         DISARG OCT,<TAC-20(P)>
4424:         [ASCIZ /
4425: /]
4426:         -1
4427:         POPACS
4428:         POPJ P,
    DPYSER page# 0112 next  prev
4430: ;GET CHAN SPECIFIED BY TAC(31-35) IF FREE
4431: 
4432: ↑DDCGET:HLLZ AC3,TAC
4433:         MOVEI AC1,(TAC)
4434:         MOVSI AC2,377
4435:         CONO PI,SCNOFF
4436:         TDNN AC2,DDTAB(AC1)
4437:         JRST DDCG1
4438:         CONO PI,SCNON
4439:         HLL TAC,DDTAB(AC1)      ;TELL HIM HOW HE LOST
4440:         POPJ P,
4441: 
4442: DDCG1:  LDB AC1,[DDALST(AC1)]   ;IT'S FREE - SCAN FOR GUY POINTING TO IT
4443:         TDNE AC2,DDTAB(AC1)
4444:         JRST DDCG1
4445:         IORM AC3,DDTAB(TAC)
4446:         LDB AC3,[DDLNK(TAC)]    ;SO WE CAN LINK IT OUT
4447:         DPB AC3,[DDLNK(AC1)]
4448:         CONO PI,SCNON
4449:         MOVEI AC1,(TAC)
4450:         JRST DDGET2
4451: 
4452: ;GET ANY FREE CHAN
4453: 
4454: DDAGET: HLLZ AC3,TAC
4455:         CONO PI,SCNOFF
4456:         MOVE AC1,DDFLST
4457:         CAIN AC1,DDELNK
4458:         JRST SCNONJ
4459:         LDB AC2,[DDLNK(AC1)]
4460:         MOVEM AC2,DDFLST
4461:         IORM AC3,DDTAB(AC1)
4462:         CONO PI,SCNON
4463:         HRRI TAC,(AC1)
4464: ;COMMON CODE FOR BOTH FLAVORS OF GET. PUTS IN LIST IF GETTING FOR JOB.
4465: ;SETS AND ENFORCES PRIVACY BIT.
4466: DDGET2: SOSG DDFCNT
4467:         SETOM WHOKLU                    ;SET NO CHANNELS LEFT MESSAGE
4468:         TLNN TAC,300
4469:         AOJA AC1,[LDB AC2,[DDCLST(J)]   ;JOB - ADD TO ITS LIST
4470:                 DPB AC1,[DDCLST(J)]
4471:                 SOJGE AC2,[SOJA AC1,DDGET3]
4472:                 SOJA AC1,.+1]
4473:         MOVEI AC2,DDELNK
4474: DDGET3: DPB AC2,[DDLNK(AC1)]
4475:         AOS (P)
4476:         JUMPGE TAC,CPOPJ        ;THAT'S ALL IF HE'S NOT PARANOID
4477:         MOVEI AC1,(TAC)         ;ELSE FALL THRU
    DPYSER page# 0113 next  prev
4479: ;ROUTINE TO THROW ALL SPIES OFF PRIVATE CHANNEL.
4480: 
4481: ↑DDFLSH:PUSHJ P,VDBIT
4482:         PUSH P,TAC
4483:         PUSH P,TAC1
4484:         LDB TAC1,[DDUSR(AC1)]
4485:         MOVSI TAC,-DDNUM+DPYNUM ;INCLUDE "SHADOW" CHANNELS HERE
4486: DDFLS0: TDNN AC3,VDMAP(TAC)     ;HERE WE SCAN THE PERM MAPS
4487: DDFLS3: AOBJN TAC,DDFLS0
4488:         JUMPGE TAC,DDFLS1
4489:         CAIN TAC1,100(TAC)
4490:         JRST DDFLS3
4491:         PUSHJ P,VDSTR1
4492:         ANDCAM AC3,VDTMP(AC2)
4493:         PUSHJ P,VDOUT1
4494:         AOBJN TAC,DDFLS0
4495: DDFLS1: MOVSI TAC,-DDNUM
4496: DDFLS2: SKIPE AC2,LETAB+DPYNUM(TAC)     ;HERE WE SCAN THE TEMP MAPS
4497:         TDNN AC3,VDTMP(AC2)
4498: DDFLS4: AOBJN TAC,DDFLS2
4499:         JUMPGE TAC,DDFLSX
4500:         CAIN TAC1,100(TAC)
4501:         JRST DDFLS4
4502:         ANDCAM AC3,VDTMP(AC2)
4503:         PUSHJ P,VDOUT1
4504:         AOBJN TAC,DDFLS2
4505: DDFLSX: POP P,TAC1
4506:         JRST TPOPJ
4507: 
4508: ;SEE IF THIS GUY CAN HACK THIS DD CHAN (AC1)
4509: ;0 SKIPS FREE. 1 SKIP LOSE. 2 SKIPS HE'S GOT IT.
4510: DDCHEK: LDB AC2,[DDUSR(AC1)]
4511:         JUMPE AC2,CPOPJ
4512:         AOS (P)
4513:         HRRE AC3,JBTLIN(J)
4514:         JRST VDCCK0
4515: 
4516: ;GET STATUS & # OF CONSOLE CHAN, AC UNCHANGED IF NONE (NOT DD)
4517: DDCSGT: PUSHJ P,DDCFND
4518:         POPJ P,
4519:                         ;FALL THRU
4520: 
4521: ;GET STATUS OF CHAN TAC(31-35)
4522: DDSGET: HLL TAC,DDTAB(TAC)
4523:         POPJ P,
4524: 
4525: ;FIND CONSOLE CHAN FOR JOB
4526: 
4527: DDCFND: MOVE AC1,JBTLIN(J)
4528:         TLNN AC1,DDDLIN
4529:         POPJ P,
4530:         JUMPL AC1,CPOPJ ;DETACHED
4531:         HRRZ AC1,LETAB-DPYL0(AC1)
4532:         HLR TAC,PRGNUM(AC1)     ;PRETEND HE USED HIS CHAN AS ARG (PRESERVE LH)
4533:         JRST CPOPJ1
    DPYSER page# 0114 next  prev
4535: ;SET STATUS OF CONSOLE CHANNEL
4536: 
4537: DDCSST: PUSHJ P,DDCFND
4538:         POPJ P,
4539:                         ;FALL THRU
4540: 
4541: ;HERE HE CAN SET THE STATUS OF A CHANNEL IF IT'S HIS
4542: 
4543: DDSSET: MOVEI AC1,(TAC)
4544:         PUSHJ P,DDCHEK
4545:         POPJ P,
4546:         POPJ P,
4547:         MOVE AC2,DDTAB(AC1)
4548:         MOVSI AC3,DDSMSK
4549:         CONO PI,SCNOFF
4550:         ANDCAM AC3,DDTAB(AC1)
4551:         AND AC3,TAC
4552:         IORB AC3,DDTAB(AC1)
4553:         HLL TAC,AC3
4554:         CONO PI,SCNON
4555:         JUMPGE TAC,CPOPJ1
4556:         JUMPL AC2,CPOPJ1
4557:         AOS (P)
4558:         JRST DDFLSH             ;TURNING PRIVATE - FLUSH LOSERS
4559: 
4560: ;MAKES UP BIT (AC3) FROM DD CHAN (AC1)
4561: ↑VDBIT: MOVNI AC2,(AC1)
4562:         MOVSI AC3,400000
4563:         LSH AC3,(AC2)
4564:         POPJ P,
4565: 
4566: ;THIS ROUTINE UPDATES BOTH PERMANENT & TEMPORARY (IF EXISTENT) MAPS
4567: ;WITH INTS OFF TO AVOID INCONSISTENT STATES
4568: ;TAC=CONSOLE #, @(P) IS DIDDLE INSTRUCTION
4569: ↑VDSTRB:PUSHJ P,VDBIT
4570: ↑VDSTR: JUMPL TAC,VDSTRI
4571: VDSTR1: MOVEI AC2,VDMAP-VDTMP(TAC)
4572:         CONO PI,SCNOFF
4573:         XCT @(P)
4574:         SKIPE AC2,LETAB+DPYNUM(TAC)
4575:         XCT @(P)
4576:         CONO PI,SCNON
4577:         JRST CPOPJ1
4578: 
4579: VDSTRI: TLNE AC1,-1
4580:         HLLZ AC3,AC1    ;PICK UP BITS PASSED, IF ANY
4581:         SKIPN AC2,LETAB+DPYNUM(TAC)
4582:         JRST CPOPJ1
4583:         HRLI AC2,VPGACT
4584:         CONO PI,PIOFF
4585:         IDPB AC2,CLKQ           ;SET TO DO PGACT AT CLK LEVEL
4586:         CONO PI,PION
4587:         SETOM LEACT(AC2)        ;SO HEADER STAYS AROUND
4588:         MOVEI AC2,PRGACT-VDTMP(AC2)     ;MAKE PNTR TO PGACT BITS
4589:         SKIPL @(P)      ;SEE IF DIDDLING INSTR IS BOOLEAN
4590:         HRR AC3,VDTMP(AC2)      ;NOT BOOLEAN, COPY RH SO IT WON'T GET CLOBBERED
4591:         XCT @(P)
4592:         JRST CPOPJ1
4593: 
4594: ;SET EITHER TEMPORARY OR PERMANENT MAPPING, DETERMINED BY
4595: ;SIGN BIT OF DSER (CALLED FROM VDSMAP ROUTINES)
4596: VDSTRU: JUMPL DSER,VDSTR
4597:         SKIPE AC2,LETAB+DPYNUM(TAC)
4598:         XCT @(P)
4599:         JRST CPOPJ1
4600: 
4601: ;OUTPUTS CURRENT MAPPING (TEMPORARY, IF EXISTENT, ELSE PERMANENT)
4602: ;FOR CONSOLE C(TAC)
4603: ↑VDOUT: JUMPL TAC,CPOPJ         ;NO III'S HERE
4604: VDOUT1: SKIPN AC2,LETAB+DPYNUM(TAC)
4605:         MOVEI AC2,VDMAP-VDTMP(TAC)
4606:         CONO PI,SCNOFF
4607:         CONO VDS,DPYNUM(TAC)    ;THIS WRAPS AROUND TO "SHADOW" WITH TAC>DDNUM
4608:         DATAO VDS,VDTMP(AC2)
4609:         CONO PI,SCNON
4610:         POPJ P,
    DPYSER page# 0115 next  prev
4612: ;ALL-PURPOSE VDS DIDDLING UUO:
4613: ;RH(AC)=ADR
4614: ;AC11-17 = TTY#, 0 => OWN CONSOLE; AC9=1 => USE "SHADOW" CHAN INDICATED BY AC11-17
4615: ;AC0=1 => PERMANENT CHANGE, 0 => TEMP CHANGE (GOES AWAY ON RESET)
4616: ;FINAL STATUS (TEMP/PERM PER AC0) STORED IN AC, -1 IF TTY NOT DD.
4617: ;AC6-8 = OPCODE:
4618: ;       0 - NOP, NEVER SKIPS, USEFUL FOR GETTING STATUS ALONE
4619: ;       1 - SET MAP FROM C(ADR), SKIPS IF ENTIRELY SUCCESSFUL (NO PRIVACY PROBLEM)
4620: ;       2 - IOR MAP FROM C(ADR), SET ANALOG IF ≠0. SKIPS ON COMPLETE SUCCESS.
4621: ;       3 - ANDCAM MAP FROM C(ADR), CLEAR ANALOG IF ≠0. FAILS ONLY ON BAD TTY #.
4622: ;       4 - RESET MAP. IN TEMP MODE THIS RESETS TEMP←PERM. IN PERM MODE PERM MAP
4623: ;                       IS SET TO MAIN CHANNEL ALONE. FAILS ONLY ON BAD TTY #.
4624: ;       5-7 ILLEGAL. CURRENTLY NO-OPS.
4625: 
4626: ↑VDSMAP:XCTR    XR,[MOVE DAT,(TAC)]
4627:         LDB AC1,[VDOP,,TAC]
4628:         CAIL AC1,NVDOPS
4629:         POPJ P,
4630:         MOVE DSER,TAC
4631:         LDB TAC,[220700,,TAC]
4632:         TLNE DSER,VDXBIT
4633:         JRST VDMAP5
4634:         JUMPN TAC,.+2
4635:         HRRE TAC,JBTLIN(J)
4636:         SUBI TAC,DDL0
4637:         CAIGE TAC,DDNUM
4638:         JUMPGE TAC,.+2
4639:         JRST VDMAP4
4640:         SKIPL VDDSP(AC1)
4641:         JRST VDMAP2
4642:         SKIPA AC2,JBTLIN(J)
4643: VDMAP1: MOVE AC2,JBTLIN(AC2)
4644:         CAMN AC2,[-1]           ;DETACHED?
4645:         JRST VDMP1A
4646:         CAIN TAC,-DDL0(AC2)
4647:         JRST VDMAP2             ;LET HIM BY IF IT'S HIS CHAN
4648:         TLNE AC2,PTYLIN
4649:         SKIPN AC2,PTYJOB-PTYL0(AC2)     ;OR IF IT'S HIS VIA SOME PTY CHAIN
4650: VDMP1A: SKIPA AC2,JBTPRV(J)
4651:         JRST VDMAP1
4652:         TLNE AC2,UPGPRV         ;OR IF HE HAS THE MAGIC PRIVILEGE
4653:         JRST VDMAP2
4654:         MOVE AC2,[TTYATC,,ASSCON+ASSPRG]
4655:         SKIPE DDB,TTYTAB+DDL0(TAC)
4656:         TDNN AC2,DEVMOD(DDB)
4657:         JRST VDMAP2             ;OR IF IT'S FREE
4658:         LDB AC2,PJOBN
4659:         CAIE AC2,(J)
4660:         JRST VDMAP3
4661:                                 ;FALL THRU TO VDMAP2 IF HE OWNS THE CONSOLE
    DPYSER page# 0116 next  prev
4663: VDMAP2: HLL TAC,VDDSP(AC1)
4664:         TLZ TAC,400000          ;DON'T CONFUSE VDOUT, after all we're not a III
4665:         PUSHJ P,@VDDSP(AC1)
4666:         PUSHJ P,VDOUT
4667:         TLNE TAC,200000         ;DON'T SKIP IF NOT REQUESTED
4668:         AOS (P)                 ;NOTE THIS BIT WAS CLEARED BY ANY FAILURE
4669: VDMAP3: TLNN DSER,VDPERM        ;GIVE HIM APPROPRIATE FLAVOR OF STATUS
4670:         SKIPN DAT,LETAB+DPYNUM(TAC)
4671:         SKIPA TAC,VDMAP(TAC)
4672:         MOVE TAC,VDTMP(DAT)
4673:         JRST STOTAC
4674: 
4675: VDMAP5: ADDI TAC,DDNUM          ;HERE TO MAP "SHADOW" CHANNELS
4676:         CAIGE TAC,DPYNUM+DDNUM
4677:         JRST VDMAP2
4678: VDMAP4: XCTR    XW,[SETOM (UUO)]        ;NOT DD - USE POSSIBLE BUT UNLIKELY VALUE TO FLAG THIS.
4679:         POPJ P,
4680: 
4681: VDDSP:  CPOPJ1          ;DON'T EVEN BOTHER WITH VDOUT
4682:         600000,,VDSET
4683:         600000,,VDIOR
4684:         600000,,VDACM
4685:         600000,,VDRST
4686: NVDOPS←←.-VDDSP
    DPYSER page# 0117 next  prev
4688: VDSET:  PUSHJ P,VDWCHK
4689:         PUSHJ P,VDSTRU
4690:         MOVEM DAT,VDTMP(AC2)
4691:         POPJ P,
4692: 
4693: VDIOR:  TRNN DAT,17
4694:         JRST VDIOR1
4695:         MOVEI AC3,17
4696:         PUSHJ P,VDSTRU  ;CLEAR ANALOG HERE SO THESE DON'T GET OR'ED
4697:         ANDCAM AC3,VDTMP(AC2)
4698: VDIOR1: PUSHJ P,VDWCHK
4699:         PUSHJ P,VDSTRU
4700:         IORM DAT,VDTMP(AC2)
4701:         POPJ P,
4702: 
4703: VDACM:  TRNE DAT,17
4704:         TRO DAT,17      ;ANYTHING IN ANALOG FIELD CLEARS IT ALL
4705:         PUSHJ P,VDSTRU
4706:         ANDCAM DAT,VDTMP(AC2)
4707:         POPJ P,
4708: 
4709: VDRST:  JUMPL DSER,VDNORM
4710: VDRST1: SKIPN AC2,LETAB+DPYNUM(TAC)
4711:         POPJ P,
4712:         CONO PI,SCNOFF
4713:         MOVE AC3,VDMAP(TAC)
4714:         MOVEM AC3,VDTMP(AC2)    ;SET TEMP MAP FROM PERM
4715:         CONO PI,SCNON
4716:         POPJ P,
4717: 
4718: ↑VDNORM:SKIPN AC2,LETAB+DPYNUM(TAC)
4719:         SKIPA AC1,AVLCHN
4720:         HLRZ AC1,PRGNUM(AC2)
4721:         PUSHJ P,VDSTRB          ;SET BOTH MAPS TO HIS CHAN OR AVAILABLE
4722:         MOVEM AC3,VDTMP(AC2)
4723:         POPJ P,
    DPYSER page# 0118 next  prev
4725: ;ROUTINE TO BLESS BITS ABOUT TO BE TURNED ON FOR PRIVACY VIOLATION
4726: ;LOSING BITS ARE FLUSHED, AND SKIP FLAG IS CLEARED
4727: VDWCHK: MOVSI AC1,-40
4728: VDWCHL: JUMPGE DAT,VDWOK
4729:         SKIPL DDTAB(AC1)
4730:         JRST VDWOK
4731:         HRRE AC3,JBTLIN(J)
4732:         PUSHJ P,VDCCHK          ;TRYING TO LOOK AT PRIVATE CHAN, SEE IF IT'S OK
4733:         JRST VDWLUZ
4734: VDWOK:  ROT DAT,1
4735:         AOBJN AC1,VDWCHL
4736:         ROT DAT,4
4737:         TRNN DAT,17
4738:         POPJ P,
4739:         LDB AC1,[300,,DAT]
4740:         IOR DAT,VDSYNC(AC1)
4741:         POPJ P,
4742: 
4743: VDWLUZ: TLZ DAT,400000
4744:         TLZ TAC,200000
4745:         JRST VDWOK
4746: 
4747: ;ROUTINE TO SEE IF LOOKING AT PRIVATE CHAN IS LEGAL
4748: ;AC1=CHAN, TAC=MAPPED CONSOLE, AC3=MAPPING CONSOLE, J=MAPPING JOB.
4749: ↑VDCCHK:LDB AC2,[DDUSR(AC1)]
4750:         CAIN AC2,100(TAC)
4751:         JRST CPOPJ1             ;CAN ALWAYS MAP CONSOLE TO ITSELF
4752: VDCCK0: TRNE AC2,300
4753:         JRST VDCCK2             ;CONSOLE CHAN
4754: VDCCK1: CAIN J,(AC2)
4755:         JRST CPOPJ1             ;JOB OWNS IT
4756:         MOVE AC2,JBTLIN(AC2)
4757:         AOJE AC2,CPOPJ          ;DETACHED
4758:         TLNN AC2,PTYLIN
4759:         JRST VDCCK3
4760:         MOVE AC2,PTYJOB-PTYL0-1(AC2)    ;SEE IF IT CAN GET TO IT VIA PTY
4761:         JRST VDCCK1
4762: 
4763: VDCCK2: ADD AC2,[DDDLIN-1,,DDL0-100+1]
4764: VDCCK3: TLNE AC2,DDDLIN
4765:         CAIE AC3,-1(AC2)                ;JOB'S OWN CONSOLE WINS
4766:         POPJ P,
4767:         JRST CPOPJ1
4768: 
4769: BEND DPYSER
    DPYSER page# 0119 next  prev
4771: SUBTTL WHO LINE GENERATOR--R. HELLIWELL--6/APR/70
4772: COMMENT ⊗
4773:         THIS ROUTINE ALLOWS EACH LUCKY OWNER OF A DISPLAY
4774: TO HAVE ONE LINE OF "WHO" INFORMATION ON HIS SCREEN AT ANY TIME
4775: IT USES THE LINE EDITOR FOR ACTIVATION IN THE FOLLOWING MANNER.
4776: 
4777:         <ESC>W
4778:         TO DISPLAY THE WHO LINE FOR THE JOB ATTACHED TO THIS DPY.
4779: 
4780:         <ESC><N>W
4781:         TO DISPLAY THE WHO LINE FOR JOB N ON THIS DPY.
4782: 
4783:         <BREAK>W
4784:         STOP THE WHO LINE.
4785: 
4786: LOOK FOR CODE IN THE LINE EDITOR AROUND THE LABEL "ESCW".
4787: ALSO IN DPYSER.
4788: WHOSER IS CALLED FROM CLKINT.
4789: ⊗
4790: 
4791: 
4792: BEGIN WHOSER
4793: 
4794: GLOBAL DDUSR
4795: 
4796: DISJSR←←24              ;STORES RETURN
4797: DISJMP←←20              ;JUMP
4798: DISNOP←←12              ;GOOD NO-OP WITH NO BITS.
4799: DEFINE CW (C1,B1,C2,B2,C3,B3) {<BYTE (8)<B1>,<B2>,<B3>(3)<C1>,<C2>,<C3>>!4}
4800: 
4801: ;AC'S USED
4802: ;WHO IS FOR DPY # AND JOB STATUS WORD.
4803: ;TAC AND TAC1 AND AC2 ARE SORT OF TEMPORARY
4804: ;AC1 LOCATION OF FREE STORAGE BUFFER.
4805: ;AC3 BYTE POINTER TO FREE STORAGE, INDEXED BY AC1
4806: ;J CONTAINS JOB NUMBER OF WHO LINE.
4807: 
4808: ;WHOPTR 0 = LINE IS FREE.
4809: ;      >0 = LINE IS WAITING TO BE QUEUED
4810: ;      -2 OR -1 = LINE HAS BEEN QUEUED.
4811: 
4812: WHO←TEM                 ;DPY INDEX AT TOP LEVEL.
4813: 
4814: ↑WHOINI:
4815: REPEAT 0,<      ; THESE CELLS ARE ALL BETWEEN SYSBEG AND SYSEND AND THUS GET ZEROED AT SYSINI
4816:         SETZM   WHONXT                  ;NUMBER OF III DONE LAST
4817:         SETZM   WHDDNXT                 ;NUMBER OF THE DD DONE LAST
4818:         SETZM   JBSRUN                  ;BITS FOR JOBS THAT
4819:         SETZM   JBSRUN+1                ;  HAVE RUN LATELY
4820:         SETZM   FREWAT
4821:         SETZM   FRETAB                  ;FREE STORAGE POINTER FOR EACH WHO LINE
4822:         SETZM   WHOPTR                  ;POINTER TO THE DD THAT WAS DONE LAST.
4823:                                         ;SEE WHOQUE IN DPYSER
4824:         MOVE    TAC,[XWD FRETAB,FRETAB+1]
4825:         BLT     TAC,FRETAB+DDNUM+DPYNUM-1
4826: >;END REPEAT 0
4827:         POPJ    P,
    DPYSER page# 0120 next  prev
4829: ↑WHOSER:MOVE    DAT,TIME
4830:         TRNE    DAT,1                           ;EVEN TIC?
4831:         POPJ    P,                              ;NO, SKIP IT.
4832:         MOVE    AC1,FREWAT
4833:         JUMPE   AC1,.+2                         ;WAITING TO GIVE BACK FREE STORAGE?
4834:         PUSHJ   P,FSGIVE                        ;YES. DO IT.
4835:         SETZM   FREWAT
4836: ;WE DO WHO LINES FOR 5 III DISPLAYS IN 10. TICKS, THEN
4837: ;ON THE 12.TH  TICK WE DO ONE DD LINE AND THE OTHER III.
4838: WHOIII: SOSL    WHO,WHONXT                      ;NEXT GUY TO DO.
4839:         JRST    WHODO1                          ;JUMP IF THERE'S ANOTHER III TO DO
4840: WHODO:  MOVE    TAC,DDOFF                       ;DATA DISK IS OFF?
4841:         JUMPN   TAC,WHODO9                      ;JUMP IF DD IS OFF.
4842:         MOVE    TAC,WHOPTR                      ;DD WHO LINE STILL BUSY?
4843:         JUMPN   TAC,WHODO2                      ;IF SO, LEAVE EARLY.
4844: WHODO9: SOSLE   AC1,WHOKLU                      ;COUNT DOWN TO AVL MSG SHIFT
4845:         JRST    WHODO4
4846:         PUSHJ   P,DDAVST                        ;THIS MOVES IT
4847:         MOVEI   AC1,=300
4848:         MOVEM   AC1,WHOKLU      ;300 WHODO'S IS A MINUTE (BEFORE NEXT SHIFT OF MSG)
4849:         MOVEI   WHO,DDAVLU                      ;WHOKLU SET, SERVICE AVLCHN NOW
4850:         JRST    WHODO3
4851: WHODO4: SOSGE   WHO,WHDDNXT                     ;WHO'S NEXT FOR WHO
4852:         PUSHJ   P,WHOSYS                        ;END OF DD.  RECALCULATE SYSTEM LINE
4853:         LDB     WHO,[DDUSR(WHO)]                ;MAP FROM DD CHANNEL TO TTY NUMBER
4854:         CAIN    WHO,DDAVLU                      ;AVAILABLE CHANNEL?
4855:         JRST    WHODO3                          ;YES, SKIP WHODO1
4856:         CAIL    WHO,100
4857:         CAILE   WHO,177
4858:         JRST    WHODO2                          ;NOT USER'S CONSOLE
4859:         SUBI    WHO,100-DPYNUM                  ;MAKE DPY (TTY) NUMBER
4860:         PUSHJ   P,WHODO1                        ;GO REFRESH ONE MORE DD WHO LINE
4861: WHODO3: MOVEM   WHO,WHOPTR                      ;SET TO FLAG WHOQUE.
4862: WHODO2: MOVEI   WHO,DPYNUM-1                    ;START ON III DISPLAYS AGAIN
4863:         MOVEM   WHO,WHONXT                      ;SAVE INDEX OF WHO WAS DONE LAST
4864: 
4865: WHODO1: MOVE    AC1,FRETAB(WHO)                 ;GET THE FREE STORAGE BLOCK
4866:         MOVE    DDB,LETAB(WHO)                  ;GET PTR TO DPY HEADER
4867:         JUMPE   DDB,WHOCLR                      ;JUMP IF NO DPY HEADER
4868:         HRRZ    J,WHOTAB(DDB)                   ;GET JOB NUMBER FOR THIS LINE.
4869:         MOVE    DAT,JBTSTS(J)                   ;GET JOB'S STATUS WORD
4870:         TLNN    DAT,JNA                         ;IS IT STILL THERE?
4871:         SETZB   J,WHOTAB(DDB)                   ;NO, FLUSH!
4872:         JUMPE   J,WHOCLR                        ;JUMP IF NO WHO REQUEST
4873:                                                 ;CHECK FOR RELEASE OF FREE STORAGE
4874:         JUMPE   AC1,WHOSET                      ;JUMP IF WE NEED TO MAKE FS BLOCK.
4875:         MOVE    DAT,WHDDNXT
4876:         CAIGE   WHO,DPYNUM                      ;ALWAYS UPDATE SLOW PART FOR DD
4877:         TRNN    DAT,3                           ;UPDATE WHOLE III AFTER 4 DATA DISKS
4878:         JRST    WHOLIN                          ;COMPUTE ENTIRE LINE.
4879:         JRST    ALWAYS                          ;JUST DO THE FAST PART THIS TIME
4880: 
4881: WHOCLR: JUMPE   AC1,CPOPJ                       ;DO WE HAVE FREE STORAGE BLOCK
4882:         SETZM   FRETAB(WHO)                     ;YES. CLEAR FRETAB
4883:         HRRZM   AC1,FREWAT                      ;YES, QUEUE IT FOR NEXT TIC.
4884:         CAIL    WHO,DPYNUM                      ;IS THIS A DATA DISC DISPLAY?
4885:         POPJ    P,                              ;YES, LEAVE EARLY
4886:         HRRZ    DDB,LETAB(WHO)
4887:         JUMPE   DDB,CPOPJ                       ;IF SLIPPED OUT FROM UNDER US, FORGET IT
4888:         MOVEI   TAC,DISNOP                      ;RESET WHOCALL.
4889:         MOVEM   TAC,WHOCALL(DDB)
4890:         MOVSI   TAC,400000                      ;DONT SELECT III FOR SYS WHO LINE
4891:         MOVNI   AC2,(WHO)
4892:         LSH     TAC,(AC2)
4893:         ANDCAM  TAC,WHOSEL                      ;TURN OFF SET BIT
4894:         LSH     TAC,-=12                        ;DESELECT THIS III FOR SYS WHO LINE
4895:         ORM     TAC,WHOSEL                      ;TURN ON RESET BIT
4896:         JRST    WHORST                          ;RESTART POOLE AND RETURN TO CLKSER
    DPYSER page# 0121 next  prev
4898: WHOSIX: MOVEI   AC2,6                   ;CHARACTER COUNT
4899: WHOSXX: MOVEI   TAC,0                   ;DATA IN TAC1
4900:         LSHC    TAC,6
4901:         ADDI    TAC," "
4902:         IDPB    TAC,AC3
4903:         SOJG    AC2,WHOSXX
4904:         POPJ    P,
4905: 
4906: ;WSDPAD - CALL WITH
4907: ;       AC3 = BYTE POINTER
4908: ;       AC2 = CHARACTER COUNT
4909: ;       TAC = DATA
4910: ;       TAC1, UCHN, DAT ARE CLOBBERED.
4911: ;       PRINTS NUMBER WITH LEADING SPACES.
4912: ;CALL WSDPD2 WITH UCHN = RADIX; DAT = PADDING CHARACTER. AC3,AC2,TAC AS ABOVE.
4913: ;CALL WSDPD3 WITH UCHN = RADIX.  USES BLANK PADDING.
4914: WSDPAD: MOVEI   UCHN,=10
4915: WSDPD3: MOVEI   DAT," "                 ;PADDING CHARACTER
4916: WSDPD2: IDIVI   TAC,(UCHN)
4917:         HRLM    TAC1,(P)
4918:         SUBI    AC2,1                   ;COUNT A CHARACTER GENERATED.
4919:         JUMPE   TAC,WSDPD1
4920:         PUSHJ   P,WSDPD2
4921: WSDPD0: HLRZ    TAC,(P)
4922:         ADDI    TAC,"0"
4923:         IDPB    TAC,AC3
4924:         POPJ    P,
4925: 
4926: WSDPD1: SOJL    AC2,WSDPD0
4927:         IDPB    DAT,AC3
4928:         JRST    WSDPD1
4929: 
4930: WPER2D: IMULI   TAC,=100        ;PRINT TAC/TAC1 AS A PERCENTAGE IN 2 DIGITS
4931:         IDIV    TAC,TAC1
4932:         CAIL    TAC,=100
4933:         MOVEI   TAC,=99         ;PRINT 99 FOR 100
4934:                                 ;FALL INTO W0PD2
4935: 
4936: ;PRINT A 2 DIGIT DECIMAL NUMBER PADDED WITH A LEADING ZERO IF NECESSARY
4937: ;CALL WITH NUMBER IN TAC, BYTE POINTER IN AC3.  CLOBBERS TAC1
4938: W0PD2:  IDIVI   TAC,=10
4939:         ADDI    TAC,"0"
4940:         IDPB    TAC,AC3
4941:         ADDI    TAC1,"0"
4942:         IDPB    TAC1,AC3
4943:         POPJ    P,
4944: 
4945: ;PRINT A DECIMAL NUMBER PADDING WITH FOLLOWING BLANKS
4946: ;       TAC = DATA
4947: ;       AC2 = CHARACTER COUNT
4948: ;       AC3 = BYTE POINTER
4949: ;TAC, AC2, TAC1 AND DAT ARE CLOBBERED
4950: DECPDF: MOVEI   DAT," "                 ;THIS IS THE CHARACTER TO PAD WITH
4951:         PUSHJ   P,WHPRNT                ;CONVERT TAC TO ASCII AND SAVE CHARACTERS
4952:         SOJL    AC2,CPOPJ               ;ANY PADDING NEEDED?
4953:         IDPB    DAT,AC3                 ;YES.  PAD WITH A BLANK
4954:         SOJGE   AC2,.-1                 ;MORE PADDING NEEDED?
4955:         POPJ    P,                      ;NOPE
4956: 
4957: WHPRNT: IDIVI   TAC,=10                 ;ROUTINE TO DO THE WORK FOR DECPDF
4958:         HRLM    TAC1,(P)
4959:         JUMPE   TAC,.+2
4960:         PUSHJ   P,WHPRNT
4961:         HLRZ    TAC,(P)
4962:         ADDI    TAC,"0"
4963:         IDPB    TAC,AC3                 ;DEPOSIT ONE DECIMAL DIGIT
4964:         SUBI    AC2,1                   ;NOTE THAT WE HAVE PUT OUT A CHARACTER
4965:         POPJ    P,
    DPYSER page# 0122 next  prev
4967: ;THIS IS THE PART WE ALWAYS UPDATE.
4968: ALWAYS: ANDI    J,-1
4969:         MOVE    DAT,JBTSTS(J)
4970: ;       TLNN    DAT,JNA
4971: ;       JRST    [SETZM WHOTAB(DDB)      ;JOB HAS GONE AWAY.
4972: ;               POPJ P,]
4973:         MOVE    AC3,[POINT 7,WTEND+4(AC1),34]
4974:         MOVM    TAC,JOBQUE(J)           ;GET QUEUE NUMBER.
4975:         MOVE    TAC,QNAMS(TAC)          ;GET PRINT NAME.
4976:         TRO     TAC,1
4977:         MOVEM   TAC,@AC3
4978:         MOVEI   TAC," "
4979:         CAMN    J,JOB                   ;CURRENTLY RUNNING JOB?
4980:         MOVEI   TAC,"-"                 ;YES
4981:         TLNE    DAT,SWP                 ;SWAPPED OUT?
4982:         MOVEI   TAC,"*"                 ;YES
4983:         TRNE    DAT,JLOCK               ;LOCKED IN CORE?
4984:         MOVEI   TAC,"⊗"                 ;YES
4985:         DPB     TAC,AC3
4986: 
4987:         MOVEI   TAC," "
4988:         MOVE    TAC1,SPWGO(J)           ;SPACEWAR ON THE 10?
4989:         JUMPE   TAC1,ALWAY1             ;NO
4990:         MOVEI   TAC,"\"                 ;YES
4991:         MOVE    TAC1,SP2GO(J)           ;SPACEWAR ON 6 ALSO?
4992:         JUMPE   TAC1,ALWAY2             ;NO
4993:         MOVEI   TAC,"X"                 ;YES
4994:         JRST    ALWAY2
4995: 
4996: ALWAY1: MOVE    TAC1,SP2GO(J)           ;SPACEWAR ON THE 6?
4997:         JUMPE   TAC1,ALWAY2             ;NO
4998:         MOVEI   TAC,"/"                 ;YES
4999: ALWAY2: LDB     TAC1,PSEGN              ;IS THERE A SEGMENT?
5000:         JUMPE   TAC1,ALWAY3             ;NO
5001:         MOVE    TAC1,JBTSTS(TAC1)       ;YES
5002:         TLNE    TAC1,SWP                ;IS IT SWAPPED OUT?
5003:         MOVEI   TAC,"*"                 ;YES
5004: ALWAY3: IDPB    TAC,AC3
5005: 
5006: ;PRINT XTIME INCREMENT
5007:         MOVE    TAC,XTIME(J)            ;GET RUN TIME AT LAST INTERACTION
5008:         MOVEI   TAC1,"'"                ;PUNCTUATE TICKS WITH RIGHT QUOTE
5009:         TLZE    TAC,400000              ; UNLESS NO-UPDATE FLAG SET
5010:         MOVEI   TAC1,42                 ;IN WHICH CASE USE double QUOTE
5011:         DPB     TAC1,[POINT 7,WTEND+13(AC1),27] ;DEPOSIT PUNCTUATOR
5012:         MOVN    TAC,TAC
5013:         ADD     TAC,TTIME(J)            ;CALCULATE INCREMENT IN RUN TIME
5014:         JUMPE   DDB,XTALL               ;ALWAYS IF TTY (DDB=0)
5015:         HLRZ    TAC1,WHOTAB(DDB)        ;GET INCREMENT FROM LAST TIME
5016:         CAIN    TAC1,(TAC)              ;SAME?
5017:         JRST    NOXTIM                  ;YES.  DON'T UPDATE INCREMENT
5018:         HRLM    TAC,WHOTAB(DDB)         ;NO.  SAVE INCREMENT THIS TIME FOR NEXT TIME
5019: XTALL:  IDIVI   TAC,=60                 ;CONVERT TO SECONDS
5020:         PUSH    P,TAC1                  ;SAVE TICKS
5021:         MOVE    AC3,[POINT 7,WTEND+12(AC1),13]
5022:         PUSHJ   P,WHOTIM                ;PRINT X INCREMENT
5023:         IBP     AC3                     ;SKIP OVER PUNCTUATOR (ALREADY DEPOSITED)
5024:         POP     P,TAC                   ;RETRIEVE TICKS
5025:         PUSHJ   P,W0PD2                 ;PRINT TICKS
5026: 
5027: NOXTIM: MOVE    TAC,TTIME(J)            ;GET RUN TIME
5028:         JUMPE   DDB,DOTIME              ;ALWAYS DO FOR TTY WHO (DDB=0)
5029:         CAML    TAC,WHORUN(DDB)         ;TIME TO UPDATE RUN TIME YET?
5030:         JRST    DOTIME                  ;YES
5031:         ADDI    TAC,=60                 ;MAYBE NOT.  IS WHORUN REASONABLE?
5032:         CAML    TAC,WHORUN(DDB)
5033:         POPJ    P,                      ;YES
5034:         SUBI    TAC,=60                 ;NO, READJUST RUN TIME AND THEN UPDATE
5035: DOTIME: MOVE    DAT,TAC                 ;COPY RUN TIME
5036:         IDIVI   TAC,=60                 ;LEAVE SECONDS IN TAC.
5037:         SUBI    DAT,(TAC1)              ;ADJUST DAT TO LAST WHOLE SECOND OF RUN TIME
5038:         ADDI    DAT,=60                 ; AND THEN ADD ONE SECOND
5039:         SKIPE   DDB                     ;NOT FOR TTY WHO
5040:         MOVEM   DAT,WHORUN(DDB)         ; AND SAVE THAT AS TIME FOR NEXT UPDATE
5041:         MOVE    AC3,[POINT 7,WTEND+10(AC1),6]   ;FALL INTO WHOTIM
5042: 
5043: WHOTIM: IDIVI   TAC,=60*=60             ;HOURS IN TAC, MINUTES, SECONDS IN TAC1
5044:         JUMPE   TAC,[MOVEI DAT," "      ;FILL HOURS FIELD WITH ONE SPACE
5045:                 DPB DAT,AC3
5046:                 MOVEI DAT,0             ; AND ONE NULL.  THEN FILL MINUTES WITH NULLS
5047:                 IDPB DAT,AC3
5048:                 JRST WMIN]
5049:         MOVEI   DAT,"0"                 ;FLAG TO FILL MINUTES FIELD WITH 0'S
5050:         ADDI    TAC,"0"
5051:         DPB     TAC,AC3
5052:         MOVEI   TAC,":"
5053:         IDPB    TAC,AC3
5054: WMIN:   MOVE    TAC,TAC1
5055:         IDIVI   TAC,=60
5056:         PUSH    P,TAC1                  ;SAVE SECONDS
5057:         MOVEI   UCHN,=10                ;SET RADIX. DAT SET WITH FILL CHARACTER
5058:         MOVEI   AC2,2                   ;NUMBER OF CHARACTERS TO FILL.
5059:         PUSHJ   P,WSDPD2                ;WRITE DECIMAL WITH FILL.
5060:         MOVEI   TAC,":"
5061:         IDPB    TAC,AC3
5062:         POP     P,TAC
5063:         JRST    W0PD2                   ;WRITE SECONDS AS TWO CHARACTERS.  RETURN.
    DPYSER page# 0123 next  prev
5065: ; THIS ROUTINE SETS UP A NEW WHO TABLE FROM A PIECE OF FREE STORAGE
5066: 
5067: WHOSET: MOVEI   AC3,WLINK+1             ;GET SIZE.
5068:         PUSHJ   P,FSGET                 ;GET FREE STORAGE.
5069:         POPJ    P,                      ;NONE, RETURN.
5070:         MOVEM   AC1,FRETAB(WHO)         ;SAVE FREE STORAGE POINTER.
5071:         MOVE    TAC,AC1
5072:         HRLI    TAC,TITLE
5073:         BLT     TAC,WLINK(AC1)          ;PUT LINE MODEL INTO FREE STORAGE.
5074:         SETZM   WHORUN(DDB)             ;ZERO THE TIME TO UPDATE RUN TIME NEXT
5075:         CAIL    WHO,DPYNUM              ;IS THIS A DD DISPLAY?
5076:         JRST    WHOLIN                  ;YES, NOTHING SPECIAL TO DO
5077:         MOVEI   TAC,DISNOP              ;IIIs DONT DO THEIR OWN SYSTEM WHO LINE
5078:         MOVEM   TAC,2(AC1)              ; SO A NO-OP REPLACES THE JMP TO SYS LINE
5079:         HRLI    AC1,DISJMP
5080:         MOVSM   AC1,WLINK(AC1)          ;STORE JUMP BACK TO FRONT OF BLOCK.
5081:         HRLI    AC1,DISJSR
5082:         MOVE    AC3,LETAB(WHO)
5083:         JUMPE   AC3,WHOCLR              ;JUMP IF DPY HEADER DISAPPEARED
5084:         MOVSM   AC1,WHOCALL(AC3)        ;STORE JSR TO FS BLOCK WHERE III WILL HIT IT
5085:         ANDI    AC1,-1                  ;CLEAR LEFT SIDE.
5086:         MOVSI   TAC,400000              ;SELECT THIS III FOR SYS WHO LINE
5087:         MOVNI   AC2,(WHO)
5088:         LSH     TAC,(AC2)
5089:         ORM     TAC,WHOSEL              ;TURN ON SET BIT
5090:         LSH     TAC,-=12                ;DONT DESELECT THIS III FOR SYS WHO LINE
5091:         ANDCAM  TAC,WHOSEL              ;TURN OFF RESET BIT
5092: ↑WHOLIN:PUSHJ   P,ALWAYS
5093: ;       HRRZ    TAC,WHOTAB(DDB)         ;HAS JOB GONE AWAY?
5094: ;       JUMPE   TAC,CPOPJ               ;YES. DON'T WORK AT IT.
5095:         HRRZ    TAC,J
5096:         MOVE    AC3,[POINT 7,WTEND(AC1)]
5097:         MOVEI   AC2,2                   ;2 CHARACTERS
5098:         PUSHJ   P,WSDPAD                ;WRITE DECIMAL JOB NUMBER
5099:         MOVE    AC3,[POINT 7,WTEND(AC1),27]
5100:         MOVE    TAC1,PRJPRG(J)          ;PROJECT-PROGRAMMER INITIALS.
5101:         PUSHJ   P,WHOSIX                ;DO SIXBIT OUTPUT
5102:         HRRE    TAC,JBTLIN(J)           ;GET LINE NUMBER AND SEE IF DETACHED
5103:         JUMPL   TAC,[MOVE TAC1,[ASCID /  DET/]
5104:                 MOVEM TAC1,WTEND+2(AC1)
5105:                 JRST WLRET]
5106:         MOVEI   AC2,5                   ;NOT DETACHED.  PRINT LINE NO IN 5 SPACES
5107:         MOVEI   UCHN,10                 ;OCTAL RADIX
5108:         PUSHJ   P,WSDPD3                ;WRITE IT WITH BLANK PADDING
    DPYSER page# 0124 next  prev
5110: WLRET:  MOVE    AC3,[POINT 7,WTEND+5(AC1),20]
5111:         MOVE    TAC1,JOBNAM(J)                  ;JOB NAME
5112:         PUSHJ   P,WHOSIX
5113:         MOVE    TAC,JBTADR(J)                   ;CORE SIZE.
5114:         JUMPE   TAC,[LDB TAC,IMGIN              ;IF SWAPPED OUT, GET SWAPPED SIZE
5115:                 JRST WSIZE]
5116:         HLRZ    TAC,TAC
5117:         AOJ     TAC,
5118:         LSH     TAC,-12
5119: WSIZE:  MOVEI   AC2,4                   ;4 CHARACTERS OUT, PAD WITH BLANKS
5120:         PUSHJ   P,WSDPAD                ;WHOSER DECIMAL PAD OUTPUT
5121: 
5122:         MOVE    AC3,[POINT 7,WTEND+11(AC1),20]  ;OVERALL RUN/WAIT PERCENTAGE
5123:         MOVE    TAC,TTIME(J)                    ;RUN TIME
5124:         MOVE    TAC1,JBTWAT(J)                  ;WAIT TIME
5125:         JUMPGE  TAC1,.+2                        ;IS WAIT TIME HONEST?
5126:         ADD     TAC1,UPTIME                     ;NO.  ADJUST IT
5127:         PUSH    P,TAC1                          ;SAVE TOTAL WAIT TIME
5128:         PUSHJ   P,WPER2D                        ;PRINT PERCENTAGE IN 2 COLS WITH LEADING ZERO
5129: 
5130:         MOVE    AC3,[POINT 7,WTEND+14(AC1),13]  ;INCREMENTAL RUN/WAIT PERCENTAGE
5131:         MOVE    TAC,TTIME(J)                    ;RUN TIME
5132:         MOVE    TAC1,XTIME(J)                   ;RUN TIME LAST SAVED
5133:         TLZ     TAC1,400000                     ;CLEAR NO-UPDATE BIT
5134:         SUB     TAC,TAC1                        ;CALCULATE INCREMENTAL RUN TIME
5135:         POP     P,TAC1                          ;RETRIEVE CURRENT WAIT TIME
5136:         SUB     TAC1,JB2WAT(J)                  ;CALCULATE INCREMENTAL WAIT TIME
5137:         PUSHJ   P,WPER2D                        ;PRINT PERCENTAGE IN 2 COLS WITH LEADING ZERO
5138: 
5139:         MOVS    TAC1,DSKOPS(J)                  ;GET NUMBER OF DSK OPS
5140:         HLRZ    TAC,TAC1                        ;TOTAL NO OF DSK OPS
5141:         SUBI    TAC,(TAC1)                      ;LESS PREVIOUS TOTAL
5142:         MOVEI   AC2,6                           ;6 COLS
5143:         PUSHJ   P,WSDPAD                        ;LEADING BLANKS, DECIMAL NUMBER
5144: 
5145:         LDB     TAC,PSEGN                       ;DOES HE HAVE A SECOND SEGMENT?
5146:         JUMPE   TAC,[MOVEI TAC,DISNOP           ;NO
5147:                 MOVEM TAC,WTEND+16(AC1)
5148:                 MOVEM TAC,WTEND+17(AC1)
5149:                 JRST WALIAS]
5150:         MOVE    AC3,[POINT 7,WTEND+16(AC1),6]   ;YES
5151:         MOVEI   TAC1,1
5152:         MOVEM   TAC1,WTEND+16(AC1)
5153:         MOVEM   TAC1,WTEND+17(AC1)
5154:         MOVEI   TAC1," "
5155:         DPB     TAC1,AC3                        ;PRECEDE SEGMENT NAME WITH 1 SPACE
5156:         MOVE    TAC1,JOBNAM(TAC)
5157:         MOVEI   AC2,7                           ;WRITE SIXBIT + 1 SPACE
5158:         PUSHJ   P,WHOSXX
5159: 
5160: WALIAS: MOVE    TAC1,DSKPPN(J)                  ;DOES HE HAVE AN ALIAS?
5161:         JUMPE   TAC1,[MOVEI TAC,DISNOP          ;NOPE
5162:                 MOVEM TAC,WTEND+20(AC1)
5163:                 MOVEM TAC,WTEND+21(AC1)
5164:                 POPJ P,]
5165:         MOVEI   TAC,1                           ;YES
5166:         MOVEM   TAC,WTEND+20(AC1)
5167:         MOVEM   TAC,WTEND+21(AC1)
5168:         MOVE    AC3,[POINT 7,WTEND+20(AC1),6]
5169:         MOVEI   TAC," "
5170:         DPB     TAC,AC3
5171:         MOVEI   TAC,"("
5172:         IDPB    TAC,AC3
5173:         PUSHJ   P,WHOSIX                        ;PUT IN 6 SIXBIT CHARS FROM DSKPPN
5174:         MOVEI   TAC,")"                         ; SURROUNDED BY PARENTHESES
5175:         IDPB    TAC,AC3
5176:         POPJ    P,
    DPYSER page# 0125 next  prev
5178: ↑WHOSYS:
5179:         MOVN    TAC,TTIME               ;GET CURRENT NULL TIME
5180:         EXCH    TAC,LASTNL              ;SAVE IT AND GET PREVIOUS NULL TIME
5181:         ADD     TAC,TTIME               ;FIND INCREMENT IN NULL TIME
5182:         MOVN    TAC1,UPTIME             ;GET CURRENT UPTIME
5183:         EXCH    TAC1,LASTUP             ;SAVE IT AND GET PREVIOUS UP TIME
5184:         ADD     TAC1,UPTIME             ;FIND INCREMENT IN UP TIME
5185:         JUMPE   TAC1,NONULL
5186:         IMULI   TAC,=100                ;CALCULATE NULL TIME IN PERCENT
5187:         IDIV    TAC,TAC1
5188:         MOVE    AC3,[POINT 7,COMWHO+7,13]
5189:         MOVEI   AC2,3                   ;PRINT NULL PERCENTAGE IN 3 SPACES,
5190:         PUSHJ   P,WSDPAD                ; PADDING WITH SPACES
5191: NONULL: MOVE    AC3,[POINT 7,COMWHO+15,13]
5192:         HRRZ    TAC,TIMDAT              ;GET TIME OF DAY IN SECS
5193:         IDIVI   TAC,=60                 ;MINS INTO TAC, SECS INTO TAC1
5194:         IDIVI   TAC,=60                 ;HOURS INTO TAC, MINS INTO TAC1
5195:         PUSH    P,TAC1                  ;SAVE MINS
5196:         PUSHJ   P,W0PD2         ;WRITE HOURS AS 2 DECIMAL DIGITS, PADDING WITH 0'S
5197:         IBP     AC3                     ;SKIP OVER COLON AFTER HOURS
5198:         POP     P,TAC                   ;RETRIEVE MINS
5199:         PUSHJ   P,W0PD2                 ; AND WRITE 2 DIGIT NUMBER
5200: 
5201:         MOVE    AC1,THSDAT              ;GET TODAY'S DATE
5202:         CAMN    AC1,WHODAT              ;NEW DAY ARRIVED YET?
5203:         JRST    WHOSY1                  ;NO. DONT RECOMPUTE DAY AND DATE
5204:         MOVEM   AC1,WHODAT              ;YES
5205: 
5206:         MOVE    AC3,[ASCID /     /]
5207:         MOVEM   AC3,COMWHO+11           ;PUT SPACES INTO WHOLINE
5208:         MOVEM   AC3,COMWHO+12
5209:         
5210:         IDIVI   AC1,=31                 ;DAY INTO AC2
5211:         PUSH    P,AC2                   ;SAVE DAY
5212:         IDIVI   AC1,=12                 ;MONTH INTO AC2
5213:         MOVE    AC1,MONTAB(AC2)         ;GET TEXT OF MONTH
5214:         DPB     AC1,[POINT 21,COMWHO+11,34]
5215:         POP     P,TAC                   ;GET DAY BACK
5216:         ADDI    TAC,1                   ; AND CORRECT IT
5217:         MOVE    AC3,[POINT 7,COMWHO+12,6]
5218:         MOVEI   AC2,2                   ;WRITE IT IN 2 COLS
5219:         MOVEI   UCHN,=10                ; IN DECIMAL
5220:         MOVEI   DAT,0                   ; WITH LEADING NULLS
5221:         PUSHJ   P,WSDPD2
5222:         MOVE    TAC,WHODAT              ;GET DATE AGAIN
5223:         PUSHJ   P,DAYCNT                ;CONVERT TO NUMBER OF DAYS SINCE 1-1-64
5224:         IDIVI   TAC,7                   ;GET DAY OF WEEK (REMAINDER)
5225:         LSH     TAC1,1                  ;(TABLE ENTRIES ARE 2 WORDS EACH)
5226:         MOVE    TAC,DAYTAB(TAC1)
5227:         ORI     TAC,1
5228:         MOVEM   TAC,COMWHO+13           ;STORE FIRST PART OF DAY
5229:         MOVE    TAC,DAYTAB+1(TAC1)
5230:         ORI     TAC,1
5231:         MOVEM   TAC,COMWHO+14           ;STORE SECOND HALF OF DAY
5232: 
5233: WHOSY1: MOVE    TAC,DQCNT               ;GET NBR OF JOBS IN DISK QUEUE
5234:         MOVE    AC3,[POINT 7,COMWHO+10,13]
5235:         MOVEI   AC2,2                   ; AND WRITE IT IN 2 COLS
5236:         PUSHJ   P,WSDPAD                ; PADDING WITH BLANKS
5237: 
5238:         MOVE    AC3,[POINT 7,COMWHO+2,20]
5239:         MOVN    TAC,DDFCNT              ;GET NUMBER OF FREE DD CHANS
5240:         ADDI    TAC,=31                 ; AND SUBTRACT FROM TOTAL NUMBER
5241:         MOVEI   AC2,2                   ;PRINT NUMBER OF DD CHANS IN USE
5242:         PUSHJ   P,WSDPAD                ; IN 2 SPACES PADDING WITH BLANKS
5243: 
5244:         MOVE    AC1,JBSRUN              ;GET BITS FOR JOBS RUN LATELY
5245:         MOVE    AC2,JBSRUN+1
5246:         LSHC    AC1,2*=36-JOBN          ;ADJUST HIGHEST JOB'S BIT TO SIGN BIT OF AC1
5247:         SETZB   TAC,JBSRUN              ;TAC = # OF JOBS LOGGED IN.  CLEAR RUN BITS.
5248:         SETZB   TAC1,JBSRUN+1           ;TAC1= # OF JOBS RUN LATELY.
5249:         SETZB   DDB,DAT                 ;DDB = CORE OF JOBS RUN LATELY.
5250:                                         ;DAT = CORE OF ALL JOBS
5251:         MOVSI   WHO,JNA
5252:         MOVEI   J,JOBN-1
5253: WRUN1:  TDNN    WHO,JBTSTS(J)           ;IS THIS JOB LOGGED IN?
5254:         JRST    WRUN2                   ;NOPE
5255:         ADDI    TAC,1                   ;YES.  COUNT HIM
5256:         HLRZ    UCHN,JBTADR(J)          ;GET HIS CORE SIZE
5257:         JUMPN   UCHN,.+3                ;IS HE SWAPPED OUT?
5258:         LDB     UCHN,IMGIN              ;YES.  GET SIZE
5259:         LSH     UCHN,12                 ; AND ADJUST TO ACTUAL SIZE (NOT 1K BLOCKS)
5260:         ADD     DAT,UCHN                ;ADD CORE SIZE TO TOTAL FOR ALL JOBS
5261:         TLNN    AC1,400000              ;HAS THIS JOB RUN LATELY?
5262:         JRST    WRUN2                   ;NOPE.  FORGET HIM
5263:         ADDI    TAC1,1                  ;YES.  COUNT HIM
5264:         ADD     DDB,UCHN                ; AND ADD IN HIS CORE
5265: WRUN2:  LSHC    AC1,1                   ;PUT NEXT JOB'S BIT IN SIGN OF AC1
5266:         SOJG    J,WRUN1                 ;MOVE ON TO NEXT JOB, IF ANY
5267: 
5268:         PUSH    P,TAC1                  ;SAVE # OF JOBS RUN LATELY
5269:         PUSH    P,DAT                   ;SAVE TOTAL CORE SIZE
5270:         MOVEI   AC2,4                   ;WRITE # OF JOBS IN 4 SPACES,
5271:         PUSHJ   P,WSDPAD                ; PADDING WITH BLANKS,
5272:         IBP     AC3                     ; AND SKIP OVER THE COMMA (EG: 12,888)
5273:         POP     P,TAC                   ;GET BACK TOTAL CORE SIZE,
5274:         ADDI    TAC,1777                ; ROUND IT UP,
5275:         LSH     TAC,-12                 ; CONVERT TO 1K BLOCKS,
5276:         MOVEI   AC2,4                   ; AND PRINT IN 4 SPACES
5277:         PUSHJ   P,DECPDF                ; WITH FOLLOWING BLANKS
5278:         POP     P,TAC                   ;GET BACK # OF JOBS RUN LATELY
5279:         MOVEI   AC2,3                   ; AND WRITE IT IN 3 SPACES,
5280:         PUSHJ   P,WSDPAD                ; PADDING WITH BLANKS,
5281:         IBP     AC3                     ; AND SKIP OVER THE COMMA AGAIN
5282:         MOVE    TAC,DDB                 ;GET CORE OF JOBS RUN LATELY,
5283:         ADDI    TAC,1777                ; ROUND IT UP,
5284:         LSH     TAC,-12                 ; AND CONVERT TO 1K BLOCKS.
5285:         MOVEI   AC2,3                   ;WRITE IT IN 4 SPACES,
5286:         PUSHJ   P,DECPDF                ; PADDING WITH FOLLOWING BLANKS
5287: 
5288:         MOVE    TAC,CORMAX              ;GET AMOUNT OF AVAILABLE CORE,
5289:         LSH     TAC,-12                 ; CONVERT IT TO 1K BLOCKS,
5290:         MOVEI   AC2,4                   ; AND PRINT IT IN 4 SPACES,
5291:         PUSHJ   P,WSDPAD                ; PADDING WITH BLANKS
5292: 
5293:         MOVEI   WHO,37                  ;START OVER WITH FIRST DD CHAN
5294:         MOVEM   WHO,WHDDNXT
5295:         POPJ    P,
5296: 
5297: BEND WHOSER
 EOF: DPYSER end-of-file. cnt=124